*IF DEF,CONTROL,AND,DEF,OCEAN OCNDIAG1.2
C ******************************COPYRIGHT****************************** GTS2F400.6985
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.6986
C GTS2F400.6987
C Use, duplication or disclosure of this code is subject to the GTS2F400.6988
C restrictions as set forth in the contract. GTS2F400.6989
C GTS2F400.6990
C Meteorological Office GTS2F400.6991
C London Road GTS2F400.6992
C BRACKNELL GTS2F400.6993
C Berkshire UK GTS2F400.6994
C RG12 2SZ GTS2F400.6995
C GTS2F400.6996
C If no contract has been raised with this copy of the code, the use, GTS2F400.6997
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.6998
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.6999
C Modelling at the above address. GTS2F400.7000
C ******************************COPYRIGHT****************************** GTS2F400.7001
C GTS2F400.7002
CLL Routine: TSUVPNT --------------------------------------------- OCNDIAG1.3
CLL OCNDIAG1.4
CLL Purpose: To transfer tracer,u,v and barotropic currents from OCNDIAG1.5
CLL array D1,place them in workspace,and then print them OCNDIAG1.6
CLL out. OCNDIAG1.7
CLL OCNDIAG1.8
CLL Tested under compiler: cft77 OCNDIAG1.9
CLL Tested under OS version: UNICOS 5.1 OCNDIAG1.10
CLL OCNDIAG1.11
CLL Model Modification history: OCNDIAG1.12
CLL version Date OCNDIAG1.13
CLL 3.1 7/12/92 New deck. Author : G.Kelly OCNDIAG1.14
CLL 4.1 07/06/96 Allow printout of non-consecutive levels. SI ORH2F401.90
CLL 4.2 05/12/96 Changes for uncompressed dumps. SI OSI0F402.181
! 4.4 05/08/97 Change J pointers and sizes supplied to MATRIX to ORH4F404.57
! avoid printing halo rows in mpp version. R. Hill ORH4F404.58
CLL OCNDIAG1.15
CLL Programming standard : OCNDIAG1.16
CLL OCNDIAG1.17
CLL Logical components covered : OCNDIAG1.18
CLL OCNDIAG1.19
CLL System task: OCNDIAG1.20
CLL OCNDIAG1.21
CLL External documentation: OCNDIAG1.22
CLL OCNDIAG1.23
CLLEND----------------------------------------------------------------- OCNDIAG1.24
C*L Subroutine OCNDIAG1.25
OCNDIAG1.26
OCNDIAG1.27
SUBROUTINE TSUVPNT( 1,15@DYALLOC.3965
*CALL ARGSIZE
@DYALLOC.3966
*CALL ARGD1
@DYALLOC.3967
*CALL ARGDUMO
@DYALLOC.3968
*CALL ARGPTRO
@DYALLOC.3969
*CALL ARGOINDX
ORH7F402.296
& LU,ITT,NEW_IMU,HR @DYALLOC.3970
& ,NDISKB,NDISK,NDISKA,FKMQ,FKMP OSI0F402.182
& ,CSR,DXU2R,DYU2R OCNDIAG1.30
& ,KKZ) OCNDIAG1.31
OCNDIAG1.32
C*---------------------------------------------------------- OCNDIAG1.33
OCNDIAG1.34
IMPLICIT NONE OCNDIAG1.35
OCNDIAG1.36
*CALL TYPSIZE
@DYALLOC.3971
! ORH3F402.353
*CALL TYPPTRO
@DYALLOC.3972
*CALL TYPOINDX
ORH7F402.297
*CALL TYPD1
@DYALLOC.3973
*CALL TYPDUMO
@DYALLOC.3974
*CALL CNTLOCN
OSI0F402.183
*CALL C_MDI
OCNDIAG1.39
OCNDIAG1.40
C*L External subroutines called OCNDIAG1.41
OCNDIAG1.42
EXTERNAL MATRIX,UNPACK OCNDIAG1.43
OCNDIAG1.44
C*---------------------------------------------------------- OCNDIAG1.45
OCNDIAG1.46
C*L Argument list OCNDIAG1.47
OCNDIAG1.48
OCNDIAG1.49
INTEGER OCNDIAG1.50
& LU ! Disc unit number (if continuous IO) OCNDIAG1.51
& ,ITT ! Timestep counter OCNDIAG1.52
& ,NEW_IMU @DYALLOC.3975
& ,NDISKB,NDISK,NDISKA OCNDIAG1.54
& ,KKZ(KM) ! Levels to be printed OCNDIAG1.55
OCNDIAG1.56
REAL OCNDIAG1.57
& HR(IMT,JMT) ! Reciprocal of depth at u,v points OCNDIAG1.58
OCNDIAG1.59
REAL OCNDIAG1.60
& FKMQ(IMT,JMT) OCNDIAG1.61
& ,FKMP(IMT,JMT) OSI0F402.184
& ,CSR(JMT) OCNDIAG1.62
& ,DXU2R(IMT) OCNDIAG1.63
& ,DYU2R(JMT) OCNDIAG1.64
OCNDIAG1.65
C*---------------------------------------------------------- OCNDIAG1.66
OCNDIAG1.67
C Local variables OCNDIAG1.68
OCNDIAG1.69
INTEGER OCNDIAG1.70
& I,J,K,N ! Local indices OCNDIAG1.71
& ,klast ! Deepest level required for printing OCNDIAG1.72
& ,nlev ! No. of levels " " " OCNDIAG1.73
& ,kindex ! Local index OCNDIAG1.74
& ,nzerotr(KM,NT) ! Counter of zeroes in temp. field OCNDIAG1.75
& ,MSB OCNDIAG1.76
&,JDIM ! Dimension for U,V data extraction OSI0F402.185
& ,LUM12 OCNDIAG1.77
& ,M ! Local index to identify tracer no. OCNDIAG1.78
OCNDIAG1.79
REAL OCNDIAG1.80
& tracer(IMT,JMT) OCNDIAG1.81
& ,work1(IMT,JMT) ! } OCNDIAG1.82
& ,work2(IMT,JMT) ! } local 2-d fields OCNDIAG1.83
& ,sofset ! Offset in salinity values from dump OCNDIAG1.84
& ,sland ! Value of salinity used over land OCNDIAG1.85
& ,SCL ! Scaling factor use in MATRIX OCNDIAG1.86
& ,diag1,diag2 ! Diagonal differences in stream-function OCNDIAG1.87
& ,zero ! Local constant (=0.0) OCNDIAG1.88
& ,AVTR(KM,NT) ! ACCUM./AV. TRACER VALUES ON EACH LEVEL OCNDIAG1.89
& ,O_RMDI ! Missing data indicator OCNDIAG1.90
& ,U(IMT,JMT) ! OCNDIAG1.91
& ,V(IMT,JMT) ! OCNDIAG1.92
& ,P(IMT,JMT) ! Stream function OCNDIAG1.93
OCNDIAG1.94
OCNDIAG1.95
OCNDIAG1.96
OCNDIAG1.97
CL 1.Find out for which time level data is valid OCNDIAG1.98
CL MSB=1 : Data transfer for present time is valid OCNDIAG1.99
CL MSB=2 : Data transfer for timestep before or after is valid OCNDIAG1.100
OCNDIAG1.101
LUM12=LU-12 OCNDIAG1.102
IF(LUM12.EQ.NDISKB) MSB=2 OCNDIAG1.103
IF(LUM12.EQ.NDISK) MSB=1 OCNDIAG1.104
IF(LUM12.EQ.NDISKA) MSB=2 OCNDIAG1.105
OCNDIAG1.106
OCNDIAG1.107
OCNDIAG1.108
CL 2.Find deepest level required for printing OCNDIAG1.109
OCNDIAG1.110
klast=0 OCNDIAG1.111
DO N=1,KM OCNDIAG1.112
IF (klast.LT.KKZ(N)) klast=KKZ(N) OCNDIAG1.113
END DO OCNDIAG1.114
OCNDIAG1.115
CL 3.Find number of levels required for printing OCNDIAG1.116
OCNDIAG1.117
nlev=0 OCNDIAG1.118
DO N=1,klast OCNDIAG1.119
IF (KKZ(N).NE.0) nlev=nlev+1 OCNDIAG1.120
END DO OCNDIAG1.121
OCNDIAG1.122
CL 4.Set constants OCNDIAG1.123
OCNDIAG1.124
SCL=1. OCNDIAG1.125
zero=0. OCNDIAG1.126
sofset=0.035 OCNDIAG1.127
sland=0.04499 OCNDIAG1.128
OCNDIAG1.129
CL 5.Zero out the work areas and P OCNDIAG1.130
OCNDIAG1.131
DO J=J_1,J_JMT ORH3F402.354
DO I=1,IMT OCNDIAG1.133
work1(I,J) = zero OCNDIAG1.134
work2(I,J) = zero OCNDIAG1.135
P(I,J)=zero OCNDIAG1.136
END DO OCNDIAG1.137
END DO OCNDIAG1.138
OCNDIAG1.139
CL 6.Calculate and print out the barotropic current OCNDIAG1.140
CL if and only if joc_stream > 1 OCNDIAG1.141
OCNDIAG1.142
IF (joc_stream(1) .GT. 1) THEN OCNDIAG1.143
DO J=J_1,J_JMT ORH3F402.355
DO I=1,IMT OCNDIAG1.145
P(I,J)=D1(joc_stream(1)-1+IMT*(J-1)+I) OCNDIAG1.146
END DO OCNDIAG1.147
END DO OCNDIAG1.148
OCNDIAG1.149
DO J=J_1,J_JMTM1 ORH3F402.356
DO I=1,NEW_IMU @DYALLOC.3976
diag1=P(I+1,J+1)-P(I,J) OCNDIAG1.152
diag2=P(I,J+1)-P(I+1,J) OCNDIAG1.153
work1(I,J)=-(diag1+diag2)*DYU2R(J+1)*HR(I,J+1) OCNDIAG1.154
work2(I,J)=(diag1-diag2)*DXU2R(I)*HR(I,J+1)*CSR(J+1) OCNDIAG1.155
END DO OCNDIAG1.156
END DO OCNDIAG1.157
OCNDIAG1.158
WRITE (6,9000) ITT OCNDIAG1.159
CALL MATRIX
(work1(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.59
WRITE (6,9001) ITT OCNDIAG1.161
CALL MATRIX
(work2(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.60
OCNDIAG1.163
OCNDIAG1.164
ENDIF OCNDIAG1.165
OCNDIAG1.166
CL 7.Read in the baroclinic currents and zero out arrays OCNDIAG1.167
OCNDIAG1.168
OCNDIAG1.169
O_RMDI=0.0 OCNDIAG1.170
DO kindex=1,nlev OCNDIAG1.171
DO J=J_1,J_JMT ORH3F402.357
DO I=1,IMT OCNDIAG1.173
u(I,J)=zero OCNDIAG1.174
v(I,J)=zero OCNDIAG1.175
END DO OCNDIAG1.176
END DO OCNDIAG1.177
OCNDIAG1.178
CL 7.1 Unpack u-velocity and place in array u OCNDIAG1.179
OCNDIAG1.180
IF (L_OCOMP) THEN OSI0F402.186
OSI0F402.187
CALL UNPACK
(1,JMT,KKZ(kindex),KKZ(kindex),JMT,KM, ORH2F401.91
& IMT,JMT,1,O_CFI1,O_CFI2, OCNDIAG1.182
& joc_no_segs,O_CFI3,joc_no_seapts, OCNDIAG1.183
& D1(joc_u(MSB)),u(1,1), OCNDIAG1.184
& O_RMDI,CYCLIC_OCEAN) OCNDIAG1.185
OCNDIAG1.186
ELSE OSI0F402.188
*IF DEF,MPP OSI0F402.189
JDIM=JMT OSI0F402.190
*ELSE OSI0F402.191
JDIM=JMTM1 OSI0F402.192
*ENDIF OSI0F402.193
CALL OD12SLAB
(1,IMT,1,JMTM1,KKZ(kindex),KKZ(kindex) OSI0F402.194
& ,IMT,JMT,1,IMT,JDIM,KM,D1(joc_u(MSB)),u(1,1)) OSI0F402.195
OSI0F402.196
ENDIF OSI0F402.197
OSI0F402.198
CL 7.2 Unpack v-velocity and place in array v OCNDIAG1.187
OCNDIAG1.188
IF (L_OCOMP) THEN OSI0F402.199
OCNDIAG1.189
CALL UNPACK
(1,JMT,KKZ(kindex),KKZ(kindex),JMT,KM, ORH2F401.92
& IMT,JMT,1,O_CFI1,O_CFI2, OCNDIAG1.191
& joc_no_segs,O_CFI3,joc_no_seapts, OCNDIAG1.192
& D1(joc_v(MSB)),v(1,1), OCNDIAG1.193
& O_RMDI,CYCLIC_OCEAN) OCNDIAG1.194
OCNDIAG1.195
ELSE OSI0F402.200
*IF DEF,MPP OSI0F402.201
JDIM=JMT OSI0F402.202
*ELSE OSI0F402.203
JDIM=JMTM1 OSI0F402.204
*ENDIF OSI0F402.205
OSI0F402.206
CALL OD12SLAB
(1,IMT,1,JMTM1,KKZ(kindex),KKZ(kindex) OSI0F402.207
& ,IMT,JMT,1,IMT,JDIM,KM,D1(joc_v(MSB)),v(1,1)) OSI0F402.208
OSI0F402.209
ENDIF OSI0F402.210
OSI0F402.211
CL 8.Set land points to zero u,v OCNDIAG1.196
OCNDIAG1.197
OCNDIAG1.198
DO J=J_1,J_JMT ORH3F402.358
DO I=1,IMT OCNDIAG1.200
IF (FKMQ(I,J).LT.KKZ(kindex)) THEN ORH2F401.93
u(I,J)=zero OCNDIAG1.202
v(I,J)=zero OCNDIAG1.203
END IF OCNDIAG1.204
END DO OCNDIAG1.205
END DO OCNDIAG1.206
OCNDIAG1.207
CL 9.Print baroclinic currents OCNDIAG1.208
OCNDIAG1.209
WRITE (6,9002) KKZ(kindex),ITT ORH2F401.94
CALL MATRIX
(u(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.61
WRITE (6,9003) KKZ(kindex),ITT ORH2F401.95
CALL MATRIX
(v(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.62
OCNDIAG1.214
CL 10.Print out the total currents if and only if OCNDIAG1.215
CL joc_stream > 1 OCNDIAG1.216
OCNDIAG1.217
IF (joc_stream(1).GT.1) THEN OCNDIAG1.218
DO J=J_1,J_JMT ORH3F402.359
DO I=1,IMT OCNDIAG1.220
u(I,J)=u(I,J)+work1(I,J) OCNDIAG1.221
v(I,J)=v(I,J)+work2(I,J) OCNDIAG1.222
END DO OCNDIAG1.223
END DO OCNDIAG1.224
OCNDIAG1.225
WRITE (6,9008) KKZ(kindex),ITT ORH2F401.96
CALL MATRIX
(u(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.63
WRITE (6,9009) KKZ(kindex),ITT ORH2F401.97
CALL MATRIX
(v(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.64
OCNDIAG1.230
END IF OCNDIAG1.231
OCNDIAG1.232
END DO OCNDIAG1.233
OCNDIAG1.234
OCNDIAG1.235
CL 11.Fetch tracer data from array D1 and print it out OCNDIAG1.236
OCNDIAG1.237
CL 11.0 Zero out tracer array OCNDIAG1.238
OCNDIAG1.239
DO J=J_1,J_JMT ORH3F402.360
DO I=1,IMT OCNDIAG1.241
tracer(I,J)=zero OCNDIAG1.242
END DO OCNDIAG1.243
END DO OCNDIAG1.244
OCNDIAG1.245
OCNDIAG1.246
OCNDIAG1.247
CL 11.1 Zero out average array OCNDIAG1.248
OCNDIAG1.249
DO M=1,NT !NT=no. of tracers 1=Temperature OCNDIAG1.250
! 2=Salinity OCNDIAG1.251
! 3,4,..=User-defined OCNDIAG1.252
OCNDIAG1.253
DO kindex=1,nlev !Loop over the number of levels OCNDIAG1.254
OCNDIAG1.255
avtr(kindex,M)=zero OCNDIAG1.256
nzerotr(kindex,M)=0 OCNDIAG1.257
OCNDIAG1.258
END DO OCNDIAG1.259
END DO OCNDIAG1.260
OCNDIAG1.261
CL 11.2 Fetch tracer data and put it in unpacked array OCNDIAG1.262
OCNDIAG1.263
OCNDIAG1.264
DO M=1,NT !NT=no. of tracers 1=Temperature OCNDIAG1.265
! 2=Salinity OCNDIAG1.266
! 3,4,..=User-defined OCNDIAG1.267
OCNDIAG1.268
DO kindex=1,nlev !Loop over the number of levels OCNDIAG1.269
OCNDIAG1.270
O_RMDI=zero OCNDIAG1.271
IF (M.EQ.2) THEN OCNDIAG1.272
O_RMDI=0.01 OCNDIAG1.273
ENDIF OCNDIAG1.274
OCNDIAG1.275
IF (L_OCOMP) THEN OSI0F402.212
OSI0F402.213
CALL UNPACK
(1,JMT,KKZ(kindex),KKZ(kindex),JMT,KM, ORH2F401.98
& IMT,JMT,1,O_CFI1,O_CFI2, OCNDIAG1.277
& joc_no_segs,O_CFI3,joc_no_seapts, OCNDIAG1.278
& D1(joc_tracer(M,MSB)),tracer(1,1), OCNDIAG1.279
& O_RMDI,CYCLIC_OCEAN) OCNDIAG1.280
OSI0F402.214
ELSE OSI0F402.215
OSI0F402.216
CALL OD12SLAB
(1,IMT,1,JMT,KKZ(kindex),KKZ(kindex) OSI0F402.217
& ,IMT,JMT,1,IMT,JMT,KM,D1(joc_tracer(M,MSB)) OSI0F402.218
& ,tracer(1,1)) OSI0F402.219
OSI0F402.220
C Set land points to zero u,v OSI0F402.221
OSI0F402.222
DO J=1,JMT OSI0F402.223
DO I=1,IMT OSI0F402.224
IF (FKMP(I,J).LT.KKZ(kindex)) THEN OSI0F402.225
tracer(I,J)=O_RMDI OSI0F402.226
END IF OSI0F402.227
END DO OSI0F402.228
END DO OSI0F402.229
OSI0F402.230
ENDIF OSI0F402.231
OSI0F402.232
OSI0F402.233
OSI0F402.234
OSI0F402.235
OSI0F402.236
OCNDIAG1.281
CL 12.Accumulate fields and averages OCNDIAG1.282
OCNDIAG1.283
OCNDIAG1.284
CL 12.1 Accumulate fields but only on ocean points OCNDIAG1.285
OCNDIAG1.286
DO J=J_1,J_JMT ORH3F402.361
DO I=1,IMT OCNDIAG1.288
OCNDIAG1.289
IF (M.NE.2) THEN OCNDIAG1.290
IF (tracer(I,J).NE.zero) THEN OCNDIAG1.291
avtr(kindex,M)=avtr(kindex,M)+tracer(I,J) OCNDIAG1.292
ELSE OCNDIAG1.293
nzerotr(kindex,M)=nzerotr(kindex,M)+1 OCNDIAG1.294
ENDIF OCNDIAG1.295
ENDIF OCNDIAG1.296
OCNDIAG1.297
OCNDIAG1.298
IF (M.EQ.2) THEN OCNDIAG1.299
IF ((tracer(I,J)+sofset).LE.sland) THEN OCNDIAG1.300
avtr(kindex,M)=avtr(kindex,M)+(tracer(I,J) OCNDIAG1.301
& +sofset)*1000 OCNDIAG1.302
ELSE OCNDIAG1.303
nzerotr(kindex,M)=nzerotr(kindex,M)+1 OCNDIAG1.304
ENDIF OCNDIAG1.305
ENDIF OCNDIAG1.306
OCNDIAG1.307
END DO OCNDIAG1.308
END DO OCNDIAG1.309
OCNDIAG1.310
OCNDIAG1.311
OCNDIAG1.312
CL 13.Print out ocean results OCNDIAG1.313
OCNDIAG1.314
CL 13.1 Temperatures OCNDIAG1.315
OCNDIAG1.316
OCNDIAG1.317
IF (M.EQ.1) THEN OCNDIAG1.318
WRITE (6,9005) KKZ(kindex),ITT ORH2F401.99
CALL MATRIX
(tracer(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.65
END IF OCNDIAG1.321
OCNDIAG1.322
OCNDIAG1.323
CL 13.2 Print out salinities (in ppt) OCNDIAG1.324
CL Need to i) add on 0.035 before scaling. OCNDIAG1.325
CL ii) use the feature that land and sea-bed points set OCNDIAG1.326
CL to salinity 0.045 (to stop convection through the OCNDIAG1.327
CL sea-bed),in order to print zeroes at those points OCNDIAG1.328
CL iii) make sure that zeroes are printed on polar rows. OCNDIAG1.329
OCNDIAG1.330
OCNDIAG1.331
OCNDIAG1.332
IF (M.EQ.2) THEN OCNDIAG1.333
DO J=J_1,J_JMT ORH3F402.362
DO I=1,IMT OCNDIAG1.335
IF (J+J_OFFSET.EQ.1.OR.J+J_OFFSET.EQ.JMT_GLOBAL) THEN ORH3F402.363
work1(I,J)=zero OCNDIAG1.337
ELSE OCNDIAG1.338
work1(I,J)=tracer(I,J)+sofset OCNDIAG1.339
IF (work1(I,J).GT.sland) work1(I,J)=zero OCNDIAG1.340
END IF OCNDIAG1.341
END DO OCNDIAG1.342
END DO OCNDIAG1.343
OCNDIAG1.344
WRITE(6,9007) KKZ(kindex),ITT ORH2F401.100
SCL=0.001 OCNDIAG1.346
CALL MATRIX
(work1(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.66
END IF OCNDIAG1.348
OCNDIAG1.349
CL 13.3 Any other tracers OCNDIAG1.350
OCNDIAG1.351
IF (M.GT.2) THEN OCNDIAG1.352
WRITE(6,9010) KKZ(kindex),ITT,M ORH2F401.101
SCL=1. OCNDIAG1.354
CALL MATRIX
(tracer(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.67
END IF OCNDIAG1.356
OCNDIAG1.357
CL 14 Calculate averages OCNDIAG1.358
OCNDIAG1.359
IF (nzerotr(kindex,M).LT.(IMT*JMT)) THEN OCNDIAG1.360
avtr(kindex,M)=(avtr(kindex,M)/(IMT*JMT-nzerotr(kindex,M))) OCNDIAG1.361
ELSE OCNDIAG1.362
WRITE(6,*) 'All values of tracer ',M,' are zero OCNDIAG1.363
& on level ',KKZ(kindex) ORH2F401.102
ENDIF OCNDIAG1.365
OCNDIAG1.366
END DO OCNDIAG1.367
OCNDIAG1.368
END DO OCNDIAG1.369
OCNDIAG1.370
OCNDIAG1.371
OCNDIAG1.372
CL 15 Print out tracer averages OCNDIAG1.373
OCNDIAG1.374
DO M=1,NT OCNDIAG1.375
IF (M .EQ. 1) THEN OCNDIAG1.376
WRITE (6,9011) OCNDIAG1.377
WRITE (6,9012) OCNDIAG1.378
WRITE (6,9017) OCNDIAG1.379
ELSE IF (M .EQ. 2) THEN OCNDIAG1.380
WRITE (6,9013) OCNDIAG1.381
WRITE (6,9014) OCNDIAG1.382
WRITE (6,9017) OCNDIAG1.383
ELSE OCNDIAG1.384
WRITE (6,9020) OCNDIAG1.385
ENDIF OCNDIAG1.386
DO kindex=1,nlev OCNDIAG1.387
IF (M .GT. 2) THEN OCNDIAG1.388
WRITE (6,9015) M,KKZ(kindex),avtr(kindex,M) ORH2F401.103
ELSE OCNDIAG1.390
WRITE (6,9016) KKZ(kindex),avtr(kindex,M) ORH2F401.104
ORH2F401.105
ORH2F401.106
ORH2F401.107
END IF OCNDIAG1.392
END DO OCNDIAG1.393
END DO OCNDIAG1.394
OCNDIAG1.395
OCNDIAG1.396
C------------------------------------------------------------------- OCNDIAG1.397
9000 FORMAT(1X,//,' Zonal barotropic current (cm/s) ,', OCNDIAG1.398
& ' t-step =',I6,/) OCNDIAG1.399
9001 FORMAT(1X,//,' Meridional barotropic current (cm/s) ,', OCNDIAG1.400
& ' t-step =',I6,/) OCNDIAG1.401
9002 FORMAT(1X,//,' Zonal baroclinic current (cm/s), level',I3, OCNDIAG1.402
& ', t-step =',I6,/) OCNDIAG1.403
9003 FORMAT(1X,//,' Meridional baroclinic current (cm/s),', OCNDIAG1.404
& ' level',I3,', t-step =',I6,/) OCNDIAG1.405
9005 FORMAT(1X,//,' Temperature (deg C), level',I3, OCNDIAG1.406
& ', t-step =',I6,/) OCNDIAG1.407
9007 FORMAT(1X,//,' Salinity (ppt), level',I3, OCNDIAG1.408
& ', t-step =',I6,/) OCNDIAG1.409
9008 FORMAT(1X,//,' Zonal total current (cm/s), level',I3, OCNDIAG1.410
& ', t-step =',I6,/) OCNDIAG1.411
9009 FORMAT(1X,//,' Meridional total current (cm/s), level',I3, OCNDIAG1.412
& ', t-step =',I6,/) OCNDIAG1.413
9010 FORMAT(1X,//,' Tracer ',I2,' Level ',I3,' t-steps',I6,/) OCNDIAG1.414
9011 FORMAT(1X,/,' Level',4X,'Average temp.') OCNDIAG1.415
9012 FORMAT(15X,'(deg C)') OCNDIAG1.416
9013 FORMAT(1X,/,' Level',4X,'Average salinity') OCNDIAG1.417
9014 FORMAT(15X,'(ppt)') OCNDIAG1.418
9015 FORMAT(4X,I2,9X,I2,9X,F6.2,//) OCNDIAG1.419
9016 FORMAT(4X,I2,9X,F6.2,//) OCNDIAG1.420
9017 FORMAT(1X,'--------------------------------------------',/) OCNDIAG1.421
9020 FORMAT(1X,/,' Tracer ',4x,' Level ',4X,'Average ') OCNDIAG1.422
OCNDIAG1.423
RETURN OCNDIAG1.424
OCNDIAG1.425
END OCNDIAG1.426
OCNDIAG1.427
OCNDIAG1.428
CLL Routine: Ancilwrt --------------------------------------------- OCNDIAG1.429
CLL OCNDIAG1.430
CLL Purpose: To transfer ancillary fields from array D1,place them OCNDIAG1.431
CLL in workspace and then print them out. OCNDIAG1.432
CLL OCNDIAG1.433
CLL Tested under compiler: cft77 OCNDIAG1.434
CLL Tested under OS version: UNICOS 5.1 OCNDIAG1.435
CLL OCNDIAG1.436
CLL Model Modification history: OCNDIAG1.437
CLL version Date OCNDIAG1.438
CLL 3.1 7/12/92 New deck. Author : G.Kelly OCNDIAG1.439
CLL OCNDIAG1.440
CLL Programming standard : OCNDIAG1.441
CLL OCNDIAG1.442
CLL Logical components covered : OCNDIAG1.443
CLL OCNDIAG1.444
CLL System task: OCNDIAG1.445
CLL OCNDIAG1.446
CLL External documentation: OCNDIAG1.447
CLL OCNDIAG1.448
CLLEND----------------------------------------------------------------- OCNDIAG1.449
C*L Subroutine OCNDIAG1.450
OCNDIAG1.451
OCNDIAG1.452
SUBROUTINE ANCILWRT( 1,10@DYALLOC.3977
*CALL ARGSIZE
@DYALLOC.3978
*CALL ARGD1
@DYALLOC.3979
*CALL ARGDUMO
@DYALLOC.3980
*CALL ARGPTRO
@DYALLOC.3981
*CALL ARGOINDX
ORH7F402.298
& ITT) @DYALLOC.3982
OCNDIAG1.454
C* OCNDIAG1.455
OCNDIAG1.456
IMPLICIT NONE OCNDIAG1.457
OCNDIAG1.458
*CALL TYPSIZE
@DYALLOC.3983
*CALL TYPDUMO
@DYALLOC.3984
*CALL TYPD1
@DYALLOC.3985
*CALL TYPPTRO
@DYALLOC.3986
*CALL TYPOINDX
ORH7F402.299
*CALL C_MDI
OCNDIAG1.461
OCNDIAG1.462
C*L External subroutines called OCNDIAG1.463
OCNDIAG1.464
EXTERNAL MATRIX OCNDIAG1.465
OCNDIAG1.466
C*-------------------------------------------------- OCNDIAG1.467
OCNDIAG1.468
C*L Arguments OCNDIAG1.469
OCNDIAG1.470
INTEGER OCNDIAG1.471
& ITT OCNDIAG1.472
OCNDIAG1.473
C*-------------------------------------------------- OCNDIAG1.474
OCNDIAG1.475
C Local variables OCNDIAG1.476
OCNDIAG1.477
INTEGER OCNDIAG1.478
& I,J, OCNDIAG1.479
& JPTS OCNDIAG1.480
OCNDIAG1.481
REAL OCNDIAG1.482
& ANCIL_UM(IMT,JMT), OCNDIAG1.483
& SCL OCNDIAG1.484
OCNDIAG1.485
CL 1.Zero out ANCIL_UM OCNDIAG1.486
OCNDIAG1.487
DO J=J_1,J_JMT ORH3F402.364
DO I=1,IMT OCNDIAG1.489
ANCIL_UM(I,J)=0. OCNDIAG1.490
END DO OCNDIAG1.491
END DO OCNDIAG1.492
OCNDIAG1.493
CL 2.Transfer ancillary fields and print them out OCNDIAG1.494
OCNDIAG1.495
OCNDIAG1.496
CL 2.1 Wind stress in x-direction OCNDIAG1.497
OCNDIAG1.498
IF (joc_taux.GT.1) THEN OCNDIAG1.499
DO J=J_1,J_JMTM1 ORH3F402.365
jpts=(J-1)*IMT-1 OCNDIAG1.501
DO I=1,IMT OCNDIAG1.502
ANCIL_UM(I,J)=D1(joc_taux +jpts+I) OCNDIAG1.503
END DO OCNDIAG1.504
END DO OCNDIAG1.505
WRITE (6,9001) ITT OCNDIAG1.506
SCL=0.1 OCNDIAG1.507
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMTM1,0,SCL,0,J_OFFSET) ORH4F404.68
END IF OCNDIAG1.509
OCNDIAG1.510
OCNDIAG1.511
CL 2.2 Wind stress in y-direction OCNDIAG1.512
OCNDIAG1.513
IF (joc_tauy.GT.1) THEN OCNDIAG1.514
DO J=J_1,J_JMTM1 ORH3F402.366
jpts=(J-1)*IMT-1 OCNDIAG1.516
DO I=1,IMT OCNDIAG1.517
ANCIL_UM(I,J)=D1(joc_tauy +jpts+I) OCNDIAG1.518
END DO OCNDIAG1.519
END DO OCNDIAG1.520
WRITE (6,9002) ITT OCNDIAG1.521
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMTM1,0,SCL,0,J_OFFSET) ORH4F404.69
END IF OCNDIAG1.523
OCNDIAG1.524
OCNDIAG1.525
CL 2.3 Penetrative heat flux OCNDIAG1.526
OCNDIAG1.527
IF (joc_solar.GT.1) THEN OCNDIAG1.528
DO J=J_1,J_JMT ORH3F402.367
jpts=(J-1)*IMT-1 OCNDIAG1.530
DO I=1,IMT OCNDIAG1.531
ANCIL_UM(I,J)=D1(joc_solar+jpts+I) OCNDIAG1.532
END DO OCNDIAG1.533
END DO OCNDIAG1.534
WRITE (6,9003) ITT OCNDIAG1.535
SCL=0.0 OCNDIAG1.536
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.70
END IF OCNDIAG1.538
OCNDIAG1.539
OCNDIAG1.540
CL 2.4 Surface heat flux OCNDIAG1.541
OCNDIAG1.542
IF (joc_heat .GT.1) THEN OCNDIAG1.543
DO J=J_1,J_JMT ORH3F402.368
jpts=(J-1)*IMT-1 OCNDIAG1.545
DO I=1,IMT OCNDIAG1.546
ANCIL_UM(I,J)=D1(joc_heat +jpts+I) OCNDIAG1.547
END DO OCNDIAG1.548
END DO OCNDIAG1.549
WRITE (6,9004) ITT OCNDIAG1.550
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.71
END IF OCNDIAG1.552
OCNDIAG1.553
OCNDIAG1.554
CL 2.5 Fresh water flux OCNDIAG1.555
OCNDIAG1.556
IF (joc_ple.GT.1) THEN OCNDIAG1.557
DO J=J_1,J_JMT ORH3F402.369
jpts=(J-1)*IMT-1 OCNDIAG1.559
DO I=1,IMT OCNDIAG1.560
ANCIL_UM(I,J)=D1(joc_ple + jpts+I) OCNDIAG1.561
END DO OCNDIAG1.562
END DO OCNDIAG1.563
WRITE (6,9005) ITT OCNDIAG1.564
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.72
END IF OCNDIAG1.566
OCNDIAG1.567
OCNDIAG1.568
CL 2.6 River outflow OCNDIAG1.569
OCNDIAG1.570
IF (joc_river.GT.1) THEN OCNDIAG1.571
DO J=J_1,J_JMT ORH3F402.370
jpts=(J-1)*IMT-1 OCNDIAG1.573
DO I=1,IMT OCNDIAG1.574
ANCIL_UM(I,J)=D1(joc_river+jpts+I) OCNDIAG1.575
END DO OCNDIAG1.576
END DO OCNDIAG1.577
WRITE (6,9006) ITT OCNDIAG1.578
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.73
END IF OCNDIAG1.580
OCNDIAG1.581
OCNDIAG1.582
CL 2.7 Wind mixing energy OCNDIAG1.583
OCNDIAG1.584
IF (joc_wme.GT.1) THEN OCNDIAG1.585
DO J=J_1,J_JMT ORH3F402.371
jpts=(J-1)*IMT-1 OCNDIAG1.587
DO I=1,IMT OCNDIAG1.588
ANCIL_UM(I,J)=D1(joc_wme + jpts+I) OCNDIAG1.589
END DO OCNDIAG1.590
END DO OCNDIAG1.591
WRITE (6,9007) ITT OCNDIAG1.592
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.74
END IF OCNDIAG1.594
OCNDIAG1.595
OCNDIAG1.596
CL 2.8 Snow rate OCNDIAG1.597
OCNDIAG1.598
IF (joc_snowrate.GT.1) THEN OCNDIAG1.599
DO J=J_1,J_JMT ORH3F402.372
jpts=(J-1)*IMT-1 OCNDIAG1.601
DO I=1,IMT OCNDIAG1.602
ANCIL_UM(I,J)=D1(joc_snowrate + jpts+I) OCNDIAG1.603
END DO OCNDIAG1.604
END DO OCNDIAG1.605
WRITE (6,9008) ITT OCNDIAG1.606
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.75
END IF OCNDIAG1.608
OCNDIAG1.609
OCNDIAG1.610
CL 2.9 Climatological SST OCNDIAG1.611
OCNDIAG1.612
IF (joc_climsst .GT.1) THEN OCNDIAG1.613
DO J=J_1,J_JMT ORH3F402.373
jpts=(J-1)*IMT-1 OCNDIAG1.615
DO I=1,IMT OCNDIAG1.616
ANCIL_UM(I,J)=D1(joc_climsst + jpts +I) OCNDIAG1.617
END DO OCNDIAG1.618
END DO OCNDIAG1.619
WRITE (6,9009) ITT OCNDIAG1.620
SCL=1. OCNDIAG1.621
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.76
END IF OCNDIAG1.623
OCNDIAG1.624
OCNDIAG1.625
CL 2.10 Climatological salinity OCNDIAG1.626
OCNDIAG1.627
IF (joc_climsal .GT.1) THEN OCNDIAG1.628
DO J=J_1,J_JMT ORH3F402.374
jpts=(J-1)*IMT-1 OCNDIAG1.630
DO I=1,IMT OCNDIAG1.631
ANCIL_UM(I,J)=D1(joc_climsal + jpts +I) OCNDIAG1.632
END DO OCNDIAG1.633
END DO OCNDIAG1.634
WRITE (6,9010) ITT OCNDIAG1.635
SCL=0.001 OCNDIAG1.636
CALL MATRIX
(ANCIL_UM(1,J_1),IMT,1,IMT,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.77
END IF OCNDIAG1.638
OCNDIAG1.639
RETURN OCNDIAG1.640
OCNDIAG1.641
OCNDIAG1.642
9001 FORMAT(1X,//,' Tau-x (N/m2 x 10) , t-step =',I6,/) OCNDIAG1.643
9002 FORMAT(1X,//,' Tau-y (N/m2 x 10) , t-step =',I6,/) OCNDIAG1.644
9003 FORMAT(1X,//,' Penetrative heat flux (W/m2) , t-step =',I6,/) OCNDIAG1.645
9004 FORMAT(1X,//,' Surface heat flux (W/m2) , t-step =',I6,/) OCNDIAG1.646
9005 FORMAT(1X,//,' Fresh water flux (kg/m2/s) , t-step =',I6,/) OCNDIAG1.647
9006 FORMAT(1x,//,' River Outflow (kg/m2/s) , t-step=',I6,/) OCNDIAG1.648
9007 FORMAT(1X,//,' Wind mixing energy (W/m2) , t-step =',I6,/) OCNDIAG1.649
9008 FORMAT(1X,//,' Snow rate , t-step =',I6,/) OCNDIAG1.650
9009 FORMAT(1X,//,' Climatological SST (deg C) , t-step =',I6,/) OCNDIAG1.651
9010 FORMAT(1X,//,' Climatological salinity (ppt) , t-step =',I6,/) OCNDIAG1.652
OCNDIAG1.653
END OCNDIAG1.654
OCNDIAG1.655
*ENDIF OCNDIAG1.656