*IF DEF,OCEAN READ_REM.2
C *****************************COPYRIGHT****************************** READ_REM.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. READ_REM.4
C READ_REM.5
C Use, duplication or disclosure of this code is subject to the READ_REM.6
C restrictions as set forth in the contract. READ_REM.7
C READ_REM.8
C Meteorological Office READ_REM.9
C London Road READ_REM.10
C BRACKNELL READ_REM.11
C Berkshire UK READ_REM.12
C RG12 2SZ READ_REM.13
C READ_REM.14
C If no contract has been raised with this copy of the code, the use, READ_REM.15
C duplication or disclosure of it is strictly prohibited. Permission READ_REM.16
C to do so must first be obtained in writing from the Head of Numerical READ_REM.17
C Modelling at the above address. READ_REM.18
C ******************************COPYRIGHT****************************** READ_REM.19
CLL READ_REM.20
CLL Subroutine : READ_REM READ_REM.21
CLL READ_REM.22
CLL Author : M J Roberts READ_REM.23
CLL READ_REM.24
CLL Modification history: READ_REM.25
CLL Implemented at UM vn 4.5 18 May 1998 READ_REM.26
CLL READ_REM.27
CLL Programming standards use Cox naming convention for Cox variables READ_REM.28
CLL with the addition that lower case variables are local to the READ_REM.29
CLL routine. READ_REM.30
CLL READ_REM.31
CLL This routine reads data from possibly remote PE's, and returns READ_REM.32
CLL it to the current PE (which called the routine) READ_REM.33
CLL READ_REM.34
CLL READ_REM.35
CLLEND----------------------------------------------------------------- READ_REM.36
C* READ_REM.37
C*L -----------------Arguments--------------------------------------- READ_REM.38
C READ_REM.39
SUBROUTINE READ_REM( 1,5READ_REM.40
*CALL ARGSIZE
READ_REM.41
*CALL ARGD1
READ_REM.42
*CALL ARGDUMO
READ_REM.43
*CALL ARGPTRO
READ_REM.44
*CALL ARGOCALL
READ_REM.45
*CALL ARGOINDX
READ_REM.46
& NSLAB_ARG READ_REM.47
& ,tendfrc,imsend,jmsend,TBPMED,TBPPMED,TBPPPMED READ_REM.48
& ,dytcst2,dytcst3,dytcst4,LABS_MED,J_PE_IND_OUT ) READ_REM.49
C READ_REM.50
C Subroutine READ_REM. For each row of data required, the following READ_REM.51
C code reads the data from the dump (possibly on a PE different to the READ_REM.52
C current PE), and sends it back to the PE that will calculate the READ_REM.53
C marginal sea outflow tendencies. READ_REM.54
c READ_REM.55
c READ_REM.56
IMPLICIT NONE READ_REM.57
C READ_REM.58
*CALL TYPSIZE
READ_REM.59
*CALL OARRYSIZ
READ_REM.60
*CALL TYPD1
READ_REM.61
*CALL TYPDUMO
READ_REM.62
*CALL TYPPTRO
READ_REM.63
*CALL TYPOINDX
PXORDER.43
*CALL TYPOCALL
READ_REM.64
*CALL OTIMER
READ_REM.66
READ_REM.67
C Input variables READ_REM.68
INTEGER NSLAB_ARG READ_REM.69
&, J_PE_IND_OUT(4) ! PE's involved in reading READ_REM.70
REAL tendfrc ! Fraction of gridboxes mixed READ_REM.71
READ_REM.72
C Local variables READ_REM.73
INTEGER PE_RECV,PE_SEND,tag,info ! variables used in MPP coding READ_REM.74
INTEGER imsend(4),jmsend(4) ! indices of values needed READ_REM.75
READ_REM.76
INTEGER READ_REM.77
+ m,k,n ! indexing variables READ_REM.78
+, index_med(4) ! used for indexing points in slab READ_REM.79
+, jread_med ! local row to read data from dump READ_REM.80
+, LABS_MED ! Unit number for disk, depends if mixing timestep READ_REM.81
&, nmedpt ! Number of points mixed READ_REM.82
&, imedpt ! Loop index over such points READ_REM.83
&, kmoffset ! Offset into slab of data READ_REM.84
READ_REM.85
REAL READ_REM.86
+ FXA1,FXA2,FXB1,FXB2,FX ! local constants READ_REM.87
+, TMED(KM,NT) ! mean tracer value of Atl and Med points READ_REM.88
READ_REM.89
REAL READ_REM.90
& TBMED(NSLAB_ARG),TBPMED(NSLAB_ARG) ! slabs read from dump for READ_REM.91
&, TBPPMED(NSLAB_ARG),TBPPPMED(NSLAB_ARG) ! rows needed for calc READ_REM.92
READ_REM.93
REAL READ_REM.94
& dytcst2,dytcst3,dytcst4 ! dyt*cst for j's on their PE's READ_REM.95
READ_REM.96
C*-------------------------------------------------------------------- READ_REM.97
C BEGIN EXECUTABLE CODE READ_REM.98
C--------------------------------------------------------------------- READ_REM.99
IF (L_OTIMER) CALL TIMER
('READ_REM',3) READ_REM.100
READ_REM.101
C for each row of data required, the following code reads the data from READ_REM.102
C the dump (possibly on a PE different to the current PE), and READ_REM.103
C sends it back to the PE that will calculate the marginal sea outflow READ_REM.104
C tendencies. READ_REM.105
C Read TB if not mixing timestep, else read T (defined by LABS_MED) READ_REM.106
READ_REM.107
C READ_REM.108
C Get tracers for row J=jmsend(2) READ_REM.109
C READ_REM.110
*IF DEF,MPP READ_REM.111
IF ((JST.LE.jmsend(2)).AND.(JFIN.GE.jmsend(2))) THEN READ_REM.112
jread_med=jmsend(2)-J_OFFSET READ_REM.113
*ELSE READ_REM.114
jread_med=jmsend(2) READ_REM.115
*ENDIF READ_REM.116
READ_REM.117
CALL UMREAD
( READ_REM.118
*CALL ARGSIZE
READ_REM.119
*CALL ARGD1
READ_REM.120
*CALL ARGDUMO
READ_REM.121
*CALL ARGPTRO
READ_REM.122
& LABS_MED,jread_med,TBPMED READ_REM.123
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) READ_REM.124
READ_REM.125
dytcst2=DYT(jread_med)*CST(jread_med) READ_REM.126
*IF DEF,MPP READ_REM.127
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(2)) THEN READ_REM.128
PE_RECV = J_PE_IND_OUT(1) READ_REM.129
CALL GC_RSEND(
6001,nslab,pe_recv,info,tbpmed,tbpmed) READ_REM.130
ENDIF READ_REM.131
ENDIF ! on jmsend(2) PE READ_REM.132
READ_REM.133
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.134
READ_REM.135
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(2)) THEN READ_REM.136
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.137
PE_SEND = J_PE_IND_OUT(2) READ_REM.138
CALL GC_RRECV(
6001,nslab,pe_send,info,tbpmed,tbpmed) READ_REM.139
endif READ_REM.140
ENDIF READ_REM.141
READ_REM.142
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.143
READ_REM.144
IF ((JST.LE.jmsend(2)).AND.(JFIN.GE.jmsend(2))) THEN READ_REM.145
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(2)) THEN READ_REM.146
CALL GC_RSEND(
6002,1,pe_recv,info,dytcst2,dytcst2) READ_REM.147
ENDIF READ_REM.148
ENDIF ! on jmsend(2) PE READ_REM.149
READ_REM.150
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.151
READ_REM.152
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(2)) THEN READ_REM.153
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.154
PE_SEND = J_PE_IND_OUT(2) READ_REM.155
CALL GC_RRECV(
6002,1,pe_send,info,dytcst2,dytcst2) READ_REM.156
endif READ_REM.157
ENDIF READ_REM.158
READ_REM.159
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.160
*ENDIF READ_REM.161
READ_REM.162
C READ_REM.163
C Get tracers for row J=jmsend(3) READ_REM.164
C READ_REM.165
*IF DEF,MPP READ_REM.166
IF ((JST.LE.jmsend(3)).AND.(JFIN.GE.jmsend(3))) THEN READ_REM.167
jread_med=jmsend(3)-J_OFFSET READ_REM.168
*ELSE READ_REM.169
jread_med=jmsend(3) READ_REM.170
*ENDIF READ_REM.171
READ_REM.172
CALL UMREAD
( READ_REM.173
*CALL ARGSIZE
READ_REM.174
*CALL ARGD1
READ_REM.175
*CALL ARGDUMO
READ_REM.176
*CALL ARGPTRO
READ_REM.177
& LABS_MED,jread_med,TBPPMED READ_REM.178
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) READ_REM.179
READ_REM.180
dytcst3=DYT(jread_med)*CST(jread_med) READ_REM.181
*IF DEF,MPP READ_REM.182
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(3)) THEN READ_REM.183
PE_RECV = J_PE_IND_OUT(1) READ_REM.184
CALL GC_RSEND(
6003,nslab,pe_recv,info,tbppmed,tbppmed) READ_REM.185
ENDIF READ_REM.186
ENDIF ! on jmsend(3) PE READ_REM.187
READ_REM.188
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.189
READ_REM.190
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(3) READ_REM.191
& .and.jmsend(3).ne.0) THEN READ_REM.192
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.193
PE_SEND = J_PE_IND_OUT(3) READ_REM.194
CALL GC_RRECV(
6003,nslab,pe_send,info,tbppmed,tbppmed) READ_REM.195
endif READ_REM.196
ENDIF READ_REM.197
READ_REM.198
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.199
READ_REM.200
IF ((JST.LE.jmsend(3)).AND.(JFIN.GE.jmsend(3))) THEN READ_REM.201
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(3)) THEN READ_REM.202
PE_RECV = J_PE_IND_OUT(1) READ_REM.203
CALL GC_RSEND(
6004,1,pe_recv,info,dytcst3,dytcst3) READ_REM.204
ENDIF READ_REM.205
ENDIF ! on jmsend(3) PE READ_REM.206
READ_REM.207
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.208
READ_REM.209
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(3) READ_REM.210
& .and.jmsend(3).ne.0) THEN READ_REM.211
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.212
PE_SEND = J_PE_IND_OUT(3) READ_REM.213
CALL GC_RRECV(
6004,1,pe_send,info,dytcst3,dytcst3) READ_REM.214
endif READ_REM.215
ENDIF READ_REM.216
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.217
*ENDIF READ_REM.218
READ_REM.219
C READ_REM.220
C Get tracers for row J=jmsend(4) READ_REM.221
C READ_REM.222
*IF DEF,MPP READ_REM.223
IF ((JST.LE.jmsend(4)).AND.(JFIN.GE.jmsend(4))) THEN READ_REM.224
jread_med=jmsend(4)-J_OFFSET READ_REM.225
*ELSE READ_REM.226
jread_med=jmsend(4) READ_REM.227
*ENDIF READ_REM.228
READ_REM.229
CALL UMREAD
( READ_REM.230
*CALL ARGSIZE
READ_REM.231
*CALL ARGD1
READ_REM.232
*CALL ARGDUMO
READ_REM.233
*CALL ARGPTRO
READ_REM.234
& LABS_MED,jread_med,TBPPPMED READ_REM.235
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) READ_REM.236
C READ_REM.237
dytcst4=DYT(jread_med)*CST(jread_med) READ_REM.238
*IF DEF,MPP READ_REM.239
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(4)) THEN READ_REM.240
PE_RECV = J_PE_IND_OUT(1) READ_REM.241
CALL GC_RSEND(
6005,nslab,pe_recv,info,tbpppmed,tbpppmed) READ_REM.242
ENDIF READ_REM.243
ENDIF ! on jmsend(4) PE READ_REM.244
READ_REM.245
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.246
READ_REM.247
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(4) READ_REM.248
& .and.jmsend(4).ne.0) THEN READ_REM.249
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.250
PE_SEND = J_PE_IND_OUT(4) READ_REM.251
CALL GC_RRECV(
6005,nslab,pe_send,info,tbpppmed,tbpppmed) READ_REM.252
endif READ_REM.253
ENDIF READ_REM.254
READ_REM.255
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.256
READ_REM.257
IF ((JST.LE.jmsend(4)).AND.(JFIN.GE.jmsend(4))) THEN READ_REM.258
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(4)) THEN READ_REM.259
PE_RECV = J_PE_IND_OUT(1) READ_REM.260
CALL GC_RSEND(
6006,1,pe_recv,info,dytcst4,dytcst4) READ_REM.261
ENDIF READ_REM.262
ENDIF ! on jmsend(4) PE READ_REM.263
READ_REM.264
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.265
READ_REM.266
IF (J_PE_IND_OUT(1).NE.J_PE_IND_OUT(4) READ_REM.267
& .and.jmsend(4).ne.0) THEN READ_REM.268
if ((jst.le.jmsend(1)).and.(jfin.ge.jmsend(1))) then READ_REM.269
PE_SEND = J_PE_IND_OUT(4) READ_REM.270
CALL GC_RRECV(
6006,1,pe_send,info,dytcst4,dytcst4) READ_REM.271
endif READ_REM.272
ENDIF READ_REM.273
CALL GC_GSYNC(
O_NPROC,INFO) READ_REM.274
*ENDIF READ_REM.275
READ_REM.276
IF (L_OTIMER) CALL TIMER
('READ_REM',4) READ_REM.277
READ_REM.278
RETURN READ_REM.279
END READ_REM.280
READ_REM.281
*ENDIF READ_REM.282
READ_REM.283