/[MITgcm]/MITgcm_contrib/MPMice/beaufort/code/cpl_mpmice.F
ViewVC logotype

Diff of /MITgcm_contrib/MPMice/beaufort/code/cpl_mpmice.F

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

revision 1.14 by dimitri, Thu Mar 15 20:02:56 2012 UTC revision 1.19 by dimitri, Thu Oct 2 22:02:55 2014 UTC
# Line 23  C     == Global variables == Line 23  C     == Global variables ==
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24  #include "GRID.h"  #include "GRID.h"
25  #include "FFIELDS.h"  #include "FFIELDS.h"
26    #include "SEAICE_OPTIONS.h"
27    #include "SEAICE_SIZE.h"
28    #include "SEAICE.h"
29  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
30  # include "EXF_OPTIONS.h"  # include "EXF_OPTIONS.h"
31  # include "EXF_FIELDS.h"  # include "EXF_FIELDS.h"
32  #endif  #endif
 #ifdef ALLOW_SEAICE  
 # include "SEAICE_OPTIONS.h"  
 # include "SEAICE_SIZE.h"  
 # include "SEAICE.h"  
 #endif  
33    
34        LOGICAL  DIFFERENT_MULTIPLE        LOGICAL  DIFFERENT_MULTIPLE
35        EXTERNAL DIFFERENT_MULTIPLE        EXTERNAL DIFFERENT_MULTIPLE
# Line 60  CEOP Line 58  CEOP
58        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)
59        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)
60        _RL     local(1:sNx,1:sNy,nSx,nSy)        _RL     local(1:sNx,1:sNy,nSx,nSy)
       character*(10) itername  
   
       COMMON /FFIELDS_tmp/ fu_tmp, fv_tmp, Qnet_tmp, Qsw_tmp, EmPmR_tmp  
       _RS  fu_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  fv_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qnet_tmp     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qsw_tmp      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  EmPmR_tmp    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
61    
62  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
63          character*(10) itername
64        write(itername,'(i10.10)') myIter        write(itername,'(i10.10)') myIter
65  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
66    
# Line 106  C     Send grid dimensions (Nx,Ny) Line 97  C     Send grid dimensions (Nx,Ny)
97  # endif /* CPL_COUPLED */  # endif /* CPL_COUPLED */
98         _END_MASTER( myThid )         _END_MASTER( myThid )
99    
100    C     Send longitude East of center of grid cell
101           DO bj=1,nSy
102            DO bi=1,nSx
103             DO j=1,sNy
104              DO i=1,sNx
105               local(i,j,bi,bj) = xC(i,j,bi,bj)
106              ENDDO
107             ENDDO
108            ENDDO
109           ENDDO
110           CALL GATHER_2D( xfer_array, local, myThid )
111    # ifdef CPL_DEBUG
112           CALL PLOT_FIELD_XYRL( xC, 'xC', myIter, myThid )
113    # endif /* CPL_DEBUG */
114    # ifdef CPL_COUPLED
115           _BEGIN_MASTER( myThid )
116           IF ( myworldid .EQ. local_ocean_leader ) THEN
117            buffsize = Nx*Ny
118            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
119         &     local_ice_leader,xCTag,MPI_COMM_WORLD,mpierr)
120           ENDIF
121           _END_MASTER( myThid )
122    # endif /* CPL_COUPLED */
123    
124    C     Send latitude North of center of grid cell
125           DO bj=1,nSy
126            DO bi=1,nSx
127             DO j=1,sNy
128              DO i=1,sNx
129               local(i,j,bi,bj) = yC(i,j,bi,bj)
130              ENDDO
131             ENDDO
132            ENDDO
133           ENDDO
134           CALL GATHER_2D( xfer_array, local, myThid )
135    # ifdef CPL_DEBUG
136           CALL PLOT_FIELD_XYRL( yC, 'yC', myIter, myThid )
137    # endif /* CPL_DEBUG */
138    # ifdef CPL_COUPLED
139           _BEGIN_MASTER( myThid )
140           IF ( myworldid .EQ. local_ocean_leader ) THEN
141            buffsize = Nx*Ny
142            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
143         &     local_ice_leader,yCTag,MPI_COMM_WORLD,mpierr)
144           ENDIF
145           _END_MASTER( myThid )
146    # endif /* CPL_COUPLED */
147    
148    C     Send longitude East of SouthWest corner
149           DO bj=1,nSy
150            DO bi=1,nSx
151             DO j=1,sNy
152              DO i=1,sNx
153               local(i,j,bi,bj) = xG(i,j,bi,bj)
154              ENDDO
155             ENDDO
156            ENDDO
157           ENDDO
158           CALL GATHER_2D( xfer_array, local, myThid )
159    # ifdef CPL_DEBUG
160           CALL PLOT_FIELD_XYRL( xG, 'xG', myIter, myThid )
161    # endif /* CPL_DEBUG */
162    # ifdef CPL_COUPLED
163           _BEGIN_MASTER( myThid )
164           IF ( myworldid .EQ. local_ocean_leader ) THEN
165            buffsize = Nx*Ny
166            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
167         &     local_ice_leader,xGTag,MPI_COMM_WORLD,mpierr)
168           ENDIF
169           _END_MASTER( myThid )
170    # endif /* CPL_COUPLED */
171    
172    C     Send latitude North of SouthWest corner
173           DO bj=1,nSy
174            DO bi=1,nSx
175             DO j=1,sNy
176              DO i=1,sNx
177               local(i,j,bi,bj) = yG(i,j,bi,bj)
178              ENDDO
179             ENDDO
180            ENDDO
181           ENDDO
182           CALL GATHER_2D( xfer_array, local, myThid )
183    # ifdef CPL_DEBUG
184           CALL PLOT_FIELD_XYRL( yG, 'yG', myIter, myThid )
185    # endif /* CPL_DEBUG */
186    # ifdef CPL_COUPLED
187           _BEGIN_MASTER( myThid )
188           IF ( myworldid .EQ. local_ocean_leader ) THEN
189            buffsize = Nx*Ny
190            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
191         &     local_ice_leader,yGTag,MPI_COMM_WORLD,mpierr)
192           ENDIF
193           _END_MASTER( myThid )
194    # endif /* CPL_COUPLED */
195    
196    C     Send distance in m between SouthWest and SouthEast corner
197           DO bj=1,nSy
198            DO bi=1,nSx
199             DO j=1,sNy
200              DO i=1,sNx
201               local(i,j,bi,bj) = dxG(i,j,bi,bj)
202              ENDDO
203             ENDDO
204            ENDDO
205           ENDDO
206           CALL GATHER_2D( xfer_array, local, myThid )
207    # ifdef CPL_DEBUG
208           CALL PLOT_FIELD_XYRL( dxG, 'dxG', myIter, myThid )
209    # endif /* CPL_DEBUG */
210    # ifdef CPL_COUPLED
211           _BEGIN_MASTER( myThid )
212           IF ( myworldid .EQ. local_ocean_leader ) THEN
213            buffsize = Nx*Ny
214            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
215         &     local_ice_leader,dxGTag,MPI_COMM_WORLD,mpierr)
216           ENDIF
217           _END_MASTER( myThid )
218    # endif /* CPL_COUPLED */
219    
220    C     Send distance in m between SouthWest and NorthEast corner
221           DO bj=1,nSy
222            DO bi=1,nSx
223             DO j=1,sNy
224              DO i=1,sNx
225               local(i,j,bi,bj) = dyG(i,j,bi,bj)
226              ENDDO
227             ENDDO
228            ENDDO
229           ENDDO
230           CALL GATHER_2D( xfer_array, local, myThid )
231    # ifdef CPL_DEBUG
232           CALL PLOT_FIELD_XYRL( dyG, 'dyG', myIter, myThid )
233    # endif /* CPL_DEBUG */
234    # ifdef CPL_COUPLED
235           _BEGIN_MASTER( myThid )
236           IF ( myworldid .EQ. local_ocean_leader ) THEN
237            buffsize = Nx*Ny
238            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
239         &     local_ice_leader,dyGTag,MPI_COMM_WORLD,mpierr)
240           ENDIF
241           _END_MASTER( myThid )
242    # endif /* CPL_COUPLED */
243    
244    C     Send cosine(alpha) relative to geographic direction at grid cell center
245           DO bj=1,nSy
246            DO bi=1,nSx
247             DO j=1,sNy
248              DO i=1,sNx
249               local(i,j,bi,bj) = angleCosC(i,j,bi,bj)
250              ENDDO
251             ENDDO
252            ENDDO
253           ENDDO
254           CALL GATHER_2D( xfer_array, local, myThid )
255    # ifdef CPL_DEBUG
256           CALL PLOT_FIELD_XYRL( angleCosC, 'aCS', myIter, myThid )
257    # endif /* CPL_DEBUG */
258    # ifdef CPL_COUPLED
259           _BEGIN_MASTER( myThid )
260           IF ( myworldid .EQ. local_ocean_leader ) THEN
261            buffsize = Nx*Ny
262            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
263         &     local_ice_leader,aCStag,MPI_COMM_WORLD,mpierr)
264           ENDIF
265           _END_MASTER( myThid )
266    # endif /* CPL_COUPLED */
267    
268    C     Send sine(alpha) relative to geographic direction at grid cell center
269           DO bj=1,nSy
270            DO bi=1,nSx
271             DO j=1,sNy
272              DO i=1,sNx
273               local(i,j,bi,bj) = angleSinC(i,j,bi,bj)
274              ENDDO
275             ENDDO
276            ENDDO
277           ENDDO
278           CALL GATHER_2D( xfer_array, local, myThid )
279    # ifdef CPL_DEBUG
280           CALL PLOT_FIELD_XYRL( angleSinC, 'aSN', myIter, myThid )
281    # endif /* CPL_DEBUG */
282    # ifdef CPL_COUPLED
283           _BEGIN_MASTER( myThid )
284           IF ( myworldid .EQ. local_ocean_leader ) THEN
285            buffsize = Nx*Ny
286            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
287         &     local_ice_leader,aSNtag,MPI_COMM_WORLD,mpierr)
288           ENDIF
289           _END_MASTER( myThid )
290    # endif /* CPL_COUPLED */
291    
292    C     Send landmask of center of grid cell, 0 is land, >0 is ocean
293           DO bj=1,nSy
294            DO bi=1,nSx
295             DO j=1,sNy
296              DO i=1,sNx
297               local(i,j,bi,bj) = hFacC(i,j,1,bi,bj)
298              ENDDO
299             ENDDO
300            ENDDO
301           ENDDO
302           CALL GATHER_2D( xfer_array, local, myThid )
303    # ifdef CPL_DEBUG
304           CALL PLOT_FIELD_XYRL( hFacC, 'hFacC', myIter, myThid )
305    # endif /* CPL_DEBUG */
306    # ifdef CPL_COUPLED
307           _BEGIN_MASTER( myThid )
308           IF ( myworldid .EQ. local_ocean_leader ) THEN
309            buffsize = Nx*Ny
310            CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
311         &     local_ice_leader,hFacCtag,MPI_COMM_WORLD,mpierr)
312           ENDIF
313           _END_MASTER( myThid )
314    # endif /* CPL_COUPLED */
315    
316  C     Send ice area  C     Send ice area
317         DO bj=1,nSy         DO bj=1,nSy
318          DO bi=1,nSx          DO bi=1,nSx
# Line 204  C     Send snow thickness Line 411  C     Send snow thickness
411    
412        ENDIF ! ( myTime .EQ. startTime )        ENDIF ! ( myTime .EQ. startTime )
413    
414    C--   Apply ice open boundary conditions
415    #ifdef ALLOW_OBCS
416          IF ( useOBCS ) THEN
417           CALL OBCS_APPLY_SEAICE( myThid )
418           CALL OBCS_APPLY_UVICE( uice, vice, myThid )
419          ENDIF
420    #endif /* ALLOW_OBCS */
421    
422  C     Send ocean model time  C     Send ocean model time
423        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
424        xfer_scalar = myTime        xfer_scalar = myTime
# Line 863  C     Receive snow thickness Line 1078  C     Receive snow thickness
1078        CALL PLOT_FIELD_XYRL( HSNOW, 'snow thickness', myIter, myThid )        CALL PLOT_FIELD_XYRL( HSNOW, 'snow thickness', myIter, myThid )
1079  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
1080    
1081    C     Receive u ice velocity
1082    # ifdef CPL_COUPLED
1083          _BEGIN_MASTER( myThid )
1084          IF ( myworldid .EQ. local_ocean_leader ) THEN
1085           buffsize = Nx*Ny
1086           CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
1087         &    local_ice_leader,UiceTag,MPI_COMM_WORLD,mpistatus,mpierr)
1088          ENDIF
1089          _END_MASTER( myThid )
1090          CALL SCATTER_2D( xfer_array, local, myThid )
1091          DO bj=1,nSy
1092           DO bi=1,nSx
1093            DO j=1,sNy
1094             DO i=1,sNx
1095              UICE(i,j,bi,bj) = local(i,j,bi,bj)
1096             ENDDO
1097            ENDDO
1098           ENDDO
1099          ENDDO
1100    #  ifdef CPL_DEBUG
1101          CALL PLOT_FIELD_XYRL( local, 'uice', myIter, myThid )
1102    #  endif /* CPL_DEBUG */
1103    # endif /* CPL_COUPLED */
1104    # ifdef CPL_DEBUG
1105          CALL PLOT_FIELD_XYRL( UICE, 'uice', myIter, myThid )
1106    # endif /* CPL_DEBUG */
1107    
1108    C     Receive v ice velocity
1109    # ifdef CPL_COUPLED
1110          _BEGIN_MASTER( myThid )
1111          IF ( myworldid .EQ. local_ocean_leader ) THEN
1112           buffsize = Nx*Ny
1113           CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
1114         &    local_ice_leader,ViceTag,MPI_COMM_WORLD,mpistatus,mpierr)
1115          ENDIF
1116          _END_MASTER( myThid )
1117          CALL SCATTER_2D( xfer_array, local, myThid )
1118          DO bj=1,nSy
1119           DO bi=1,nSx
1120            DO j=1,sNy
1121             DO i=1,sNx
1122              VICE(i,j,bi,bj) = local(i,j,bi,bj)
1123             ENDDO
1124            ENDDO
1125           ENDDO
1126          ENDDO
1127    #  ifdef CPL_DEBUG
1128          CALL PLOT_FIELD_XYRL( local, 'vice', myIter, myThid )
1129    #  endif /* CPL_DEBUG */
1130    # endif /* CPL_COUPLED */
1131    # ifdef CPL_DEBUG
1132          CALL PLOT_FIELD_XYRL( VICE, 'vice', myIter, myThid )
1133    # endif /* CPL_DEBUG */
1134    
1135  C     Receive u surface stress  C     Receive u surface stress
1136  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
1137        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
# Line 877  C     Receive u surface stress Line 1146  C     Receive u surface stress
1146         DO bi=1,nSx         DO bi=1,nSx
1147          DO j=1,sNy          DO j=1,sNy
1148           DO i=1,sNx           DO i=1,sNx
1149            fu(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +            fu(i,j,bi,bj) = AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1150       &                (1.-AREA(i,j,bi,bj)) * fu_tmp(i,j,bi,bj)       &                (1.-AREA(i,j,bi,bj)) * fu   (i,j,bi,bj)
1151           ENDDO           ENDDO
1152          ENDDO          ENDDO
1153         ENDDO         ENDDO
# Line 905  C     Receive v surface stress Line 1174  C     Receive v surface stress
1174         DO bi=1,nSx         DO bi=1,nSx
1175          DO j=1,sNy          DO j=1,sNy
1176           DO i=1,sNx           DO i=1,sNx
1177            fv(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +            fv(i,j,bi,bj) = AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1178       &                (1.-AREA(i,j,bi,bj)) * fv_tmp(i,j,bi,bj)       &                (1.-AREA(i,j,bi,bj)) * fv   (i,j,bi,bj)
1179           ENDDO           ENDDO
1180          ENDDO          ENDDO
1181         ENDDO         ENDDO
# Line 933  C     Receive residual shortwave Line 1202  C     Receive residual shortwave
1202         DO bi=1,nSx         DO bi=1,nSx
1203          DO j=1,sNy          DO j=1,sNy
1204           DO i=1,sNx           DO i=1,sNx
1205            Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj) * local(i,j,bi,bj) +            Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1206       &                  (1.-AREA(i,j,bi,bj)) * Qsw_tmp(i,j,bi,bj)       &                  (1.-AREA(i,j,bi,bj)) *   Qsw(i,j,bi,bj)
1207           ENDDO           ENDDO
1208          ENDDO          ENDDO
1209         ENDDO         ENDDO
# Line 962  C     Receive heat flux Line 1231  C     Receive heat flux
1231          DO j=1,sNy          DO j=1,sNy
1232           DO i=1,sNx           DO i=1,sNx
1233            Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -            Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -
1234       &                   AREA(i,j,bi,bj) * local(i,j,bi,bj) +       &                   AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1235       &               (1.-AREA(i,j,bi,bj)) * Qnet_tmp(i,j,bi,bj)       &               (1.-AREA(i,j,bi,bj)) *  Qnet(i,j,bi,bj)
1236           ENDDO           ENDDO
1237          ENDDO          ENDDO
1238         ENDDO         ENDDO
# Line 990  C     Receive freshwater flux Line 1259  C     Receive freshwater flux
1259         DO bi=1,nSx         DO bi=1,nSx
1260          DO j=1,sNy          DO j=1,sNy
1261           DO i=1,sNx           DO i=1,sNx
1262            EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj)  * local    (i,j,bi,bj) +            EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1263       &                  ( 1. - AREA(i,j,bi,bj)) * EmPmR_tmp(i,j,bi,bj)       &                  ( 1. - AREA(i,j,bi,bj)) * EmPmR(i,j,bi,bj)
1264           ENDDO           ENDDO
1265          ENDDO          ENDDO
1266         ENDDO         ENDDO
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22