/[MITgcm]/MITgcm_contrib/sannino/OASIS_3.0_Coupler/pkg/oasis_declare_fields.F
ViewVC logotype

Contents of /MITgcm_contrib/sannino/OASIS_3.0_Coupler/pkg/oasis_declare_fields.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download)
Thu Jul 20 21:08:16 2006 UTC (19 years ago) by sannino
Branch: MAIN
CVS Tags: HEAD
o Adding OASIS package
o Adding grid refinement package

1 C $Header: /u/gcmpack/MITgcm/pkg/oasis/oasis_declare_fields.F,v 1.0 2005/07/18 23:05:09 Gianmaria Sannino Exp
2 C $Name: $
3 cgm(
4 #include "CPP_EEOPTIONS.h"
5 cgm)
6 #include "OASIS_OPTIONS.h"
7 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8 CBOP 0
9 C !ROUTINE: OASIS_DECLARE_FIELDS
10
11 SUBROUTINE OASIS_DECLARE_FIELDS
12
13
14
15 C !DESCRIPTION:
16
17 C Declare fields received and sent to OASIS
18
19 C !USES:
20 USE mod_kinds_model
21 USE mod_prism_proto
22 USE mod_prism_def_partition_proto
23 USE mod_prism_put_proto
24 USE mod_prism_get_proto
25 USE mod_prism_grids_writing
26 IMPLICIT NONE
27
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30 cc#include "EESUPPORT.h"
31 #include "PARAMS.h"
32 #include "GRID.h"
33 cgmoasis(
34 cc#include "EESUPPORT.h"
35 #include "OASIS.h"
36 #include "OASIS_PARAMS.h"
37 cgmoasis)
38 C !INPUT PARAMETERS:
39 INTEGER myThid,mpiRC
40 CEOP
41
42 C !LOCAL VARIABLES:
43 #ifdef ALLOW_OASIS
44 INTEGER jf
45 INTEGER, DIMENSION(2) :: il_var_nodims
46 INTEGER, DIMENSION(4) :: il_var_shape
47 c CHARACTER(len=8), DIMENSION(nfldout) :: fld_out ! Symb names of fields sent
48 c CHARACTER(len=8), DIMENSION(nfldin) :: fld_in ! Symb names of field received
49 c CHARACTER*8 fld_out(nfldout) ! Symb names of fields sent
50 c CHARACTER*8 fld_in(nfldin) ! Symb names of field received
51
52
53 C-- Define the number of fields sent and received
54 nfldout = 1 ! Number of fields sent
55 nfldin = 4 ! Number of fields received
56
57 C-- PSMILe coupling fields declaration
58 !
59 il_var_nodims(1) = 2 ! rank of coupling field
60 il_var_nodims(2) = 1 ! number of bundles in coupling field (always 1)
61 il_var_shape(1)= 1 ! min index for the coupling field local dimension
62 il_var_shape(2)= sNx ! max index for the coupling field local dim
63 il_var_shape(3)= 1 ! min index for the coupling field local dimension
64 il_var_shape(4)= sNy ! max index for the coupling field local dim
65
66 C-- Define name (as in namcouple) and declare each field sent by mitgcm
67
68
69 fld_out(1)='MITFLOUT'
70 c fld_out(3)=''
71 c ...
72 !
73 WRITE (il_mparout,*) ' Declare OUTPUT variables '
74 WRITE (il_mparout,*) ' ======================== '
75 DO jf=1,nfldout
76 CALL prism_def_var_proto (il_var_id_out(jf),
77 &fld_out(jf), il_part_id,
78 &il_var_nodims, PRISM_Out,
79 &il_var_shape, PRISM_Real, ierror)
80
81 IF (ierror .NE. PRISM_Ok) THEN
82 WRITE(il_mparout,*)
83 &'ERROR: ',fld_out(jf),' is not a valid name'
84 CALL prism_abort_proto(il_comp_id,
85 &'oasis_declare_fields.F','Abort')
86 ELSE
87 WRITE(il_mparout,'(i3,a2,a8,a3)') jf,'- '
88 &,fld_out(jf),' OK'
89 ENDIF
90 ENDDO
91
92 C-- Define name (as in namcouple) and declare each field received by mitgcm
93
94 C
95 C Questo per ora e' vuoto perche' nella prima configurazione mitgcm
96 C ha soltanto un file in uscita (e quindi namcouple)
97 C
98
99 fld_in(1)='SONSHLDO'
100 fld_in(2)='SOZOTAUX'
101 fld_in(3)='SOMETAUU'
102 fld_in(4)='SOZOTAUV'
103 fld_in(5)='SOMETAUY'
104 c !
105 WRITE (il_mparout,*) ' Declare INPUT variables '
106 WRITE (il_mparout,*) ' ======================== '
107 DO jf=1,nfldin
108 CALL prism_def_var_proto (il_var_id_in(jf),
109 &fld_in(jf), il_part_id,
110 &il_var_nodims, PRISM_In,
111 &il_var_shape, PRISM_Real, ierror)
112
113 IF (ierror .NE. PRISM_Ok) THEN
114 WRITE(il_mparout,*)
115 &'ERROR: ',fld_in(jf),' is not a valid name'
116 CALL prism_abort_proto(il_comp_id,
117 &'oasis_declare_fields.F','Abort')
118 ELSE
119 WRITE(il_mparout,'(i3,a2,a8,a3)') jf,'- '
120 &,fld_in(jf),' OK'
121 ENDIF
122 ENDDO
123
124
125
126 C-- PSMILe end of the declaration phase
127
128 CALL prism_enddef_proto (ierror)
129 cc CALL MPI_Barrier(MPI_COMM_MODEL,mpiRC)
130
131 #endif /* ALLOW_OASIS */
132
133 return
134 end

  ViewVC Help
Powered by ViewVC 1.1.22