*IF DEF,OCEAN @DYALLOC.4601
C ******************************COPYRIGHT****************************** GTS2F400.2143
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2144
C GTS2F400.2145
C Use, duplication or disclosure of this code is subject to the GTS2F400.2146
C restrictions as set forth in the contract. GTS2F400.2147
C GTS2F400.2148
C Meteorological Office GTS2F400.2149
C London Road GTS2F400.2150
C BRACKNELL GTS2F400.2151
C Berkshire UK GTS2F400.2152
C RG12 2SZ GTS2F400.2153
C GTS2F400.2154
C If no contract has been raised with this copy of the code, the use, GTS2F400.2155
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2156
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2157
C Modelling at the above address. GTS2F400.2158
C ******************************COPYRIGHT****************************** GTS2F400.2159
C GTS2F400.2160
CLL ROUTINE : DIAG_PRT DIAG_PRT.2
CLL DIAG_PRT.3
CLL PURPOSE : TO WRITE OUT DATA ON REQUIRED MODEL LEVELS AT THE DIAG_PRT.4
CLL : END OF AN NNERGY TIMESTEP.READING OF DATA FROM THE DIAG_PRT.5
CLL : DUMP IS THEREFORE REQUIRED,AND THIS IS DONE IN DIAG_PRT.6
CLL : SUBROUTINES ANCILPRT,AND TSUVPNT (BOTH ARE IN DECK DIAG_PRT.7
CLL : OCN_DIAG) DIAG_PRT.8
CLL DIAG_PRT.9
CLL AUTHOR : G.KELLY DATE : 7/12/92 DIAG_PRT.10
CLL DIAG_PRT.11
CLL REVIEWER: S.INESON DATE : 9/12/92 DIAG_PRT.12
CLL DIAG_PRT.13
CLL TESTED UNDER COMPILER : DIAG_PRT.14
CLL TESTED UNDER OS VERSION : DIAG_PRT.15
CLL CODE VERSION NO : DATE : 7/12/92 DIAG_PRT.16
CLL DIAG_PRT.17
CLL MODIFICATION RECORD : DIAG_PRT.18
CLL 21/05/93: DYNAMIC ALLOCATION EXTRA ARRAYS ADDED @DYALLOC.4602
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.5455
CLL 4.1 26/01/96 S'function printout now under TSUVPRT control. SI. ORH2F401.82
! 4.2 20/12/96 Pass FKMP - TSUVPNT for D1 data extraction OSI0F402.176
! S.Ineson/R.Hill OSI0F402.177
! 4.4 05/08/97 Change J pointers and sizes supplied to MATRIX to ORH4F404.78
! avoid printing halo rows in mpp version. R. Hill ORH4F404.79
CLL PROGRAMMING STANDARD : DIAG_PRT.20
CLL DIAG_PRT.21
CLL SYSTEM COMPONENTS COVERED : DIAG_PRT.22
CLL DIAG_PRT.23
CLL EXTERNAL DOCUMENTATION : DIAG_PRT.24
CLL DIAG_PRT.25
CLL --------------------------------------------------------------- DIAG_PRT.26
CLLEND DIAG_PRT.27
DIAG_PRT.28
C*L SUBROUTINE DIAG_PRT.29
DIAG_PRT.30
SUBROUTINE DIAG_PRT( 1,3DIAG_PRT.31
*CALL ARGSIZE 
@DYALLOC.4603
*CALL ARGD1 @DYALLOC.4604
*CALL ARGDUMO @DYALLOC.4605
*CALL ARGPTRO @DYALLOC.4606
*CALL ARGOCALL @DYALLOC.4607
*CALL ARGOINDX ORH7F402.292
& ITT ! ##################################################### @DYALLOC.4608
&,P,PB,PTD,PTDB OSI0F402.178
& ) DIAG_PRT.36
DIAG_PRT.37
C* DIAG_PRT.38
C RH141293.36
IMPLICIT NONE RH141293.37
C RH141293.38
DIAG_PRT.39
*CALL OARRYSIZ ORH6F401.25
*CALL TYPSIZE @DYALLOC.4609
*CALL TYPD1 @DYALLOC.4610
*CALL TYPDUMO @DYALLOC.4611
*CALL TYPPTRO @DYALLOC.4612
*CALL TYPOINDX PXORDER.16
*CALL TYPOCALL @DYALLOC.4613
*CALL UMSCALAR DIAG_PRT.42
*CALL CNTLOCN ORH1F305.5456
DIAG_PRT.45
DIAG_PRT.46
C*L EXTERNAL SUBROUTINES CALLED DIAG_PRT.47
DIAG_PRT.48
EXTERNAL DIAG_PRT.49
& MATRIX, DIAG_PRT.50
& TSUVPNT, DIAG_PRT.51
& ANCILWRT DIAG_PRT.52
DIAG_PRT.53
C*-------------------------------------------------- DIAG_PRT.54
DIAG_PRT.55
DIAG_PRT.56
C*L ARGUMENTS DIAG_PRT.57
DIAG_PRT.58
REAL ORH1F305.5458
& P(IMT_STREAM,JMT_STREAM),PB(IMT_STREAM,JMT_STREAM) ORH1F305.5459
&,PTD(IMT_STREAM,JMT_STREAM),PTDB(IMT_STREAM,JMT_STREAM) ORH1F305.5460
DIAG_PRT.63
DIAG_PRT.64
DIAG_PRT.65
INTEGER ITT DIAG_PRT.66
DIAG_PRT.67
C*-------------------------------------------------- DIAG_PRT.68
DIAG_PRT.69
CL LOCAL VARIABLES DIAG_PRT.70
DIAG_PRT.71
REAL DIAG_PRT.72
& SCL DIAG_PRT.73
DIAG_PRT.74
DIAG_PRT.78
CL 1. CHECK WHETHER AN ENERGY TIMESTEP DIAG_PRT.79
DIAG_PRT.80
NERGY=0 DIAG_PRT.81
IF (MOD(ITT,NNERGY).EQ.0) NERGY=1 DIAG_PRT.82
DIAG_PRT.83
IF (NERGY.EQ.1) THEN DIAG_PRT.84
IF (TSUVPRT) THEN ORH2F401.83
DIAG_PRT.85
DIAG_PRT.86
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORH1F305.5461
CL 2. PRINT THE STREAM FUNCTION ON AN ENERGY TIMESTEP DIAG_PRT.88
ORH1F305.5462
PRINT 8000,ITT DIAG_PRT.92
8000 FORMAT(' STREAM FUNCTION IN SVERDRUPS, TS=',I6) DIAG_PRT.93
SCL=1.E12 DIAG_PRT.94
CALL MATRIX(P(1,J_1),IMT,2,IMTM1,J_JMT,0,SCL,0,J_OFFSET) ORH4F404.80
ENDIF ! L_ONOCLIN and L_OFREESFC = false ORH1F305.5463
DIAG_PRT.97
CL 3. PRINT OUT T,S,U,V FIELDS DIAG_PRT.98
DIAG_PRT.99
IF ( KKK(1).GT.0 ) THEN ORH2F401.84
CALL TSUVPNT ( @DYALLOC.4614
*CALL ARGSIZE SN260893.1
*CALL ARGD1 @DYALLOC.4616
*CALL ARGDUMO @DYALLOC.4617
*CALL ARGPTRO @DYALLOC.4618
*CALL ARGOINDX ORH7F402.294
& LABS(NDISK),ITT,IMU, @DYALLOC.4619
& HR, DIAG_PRT.102
& NDISKB,NDISK,NDISKA,FKMQ,FKMP, OSI0F402.179
& CSR,DXU2R,DYU2R,KKK) DIAG_PRT.104
DIAG_PRT.105
ENDIF ! printout of TSUV on levels ORH2F401.85
ENDIF DIAG_PRT.106
DIAG_PRT.107
CL 4. PRINT OUT ANCILLARY FIELDS DIAG_PRT.108
DIAG_PRT.109
IF ( ANCILPRT ) THEN DIAG_PRT.110
CALL ANCILWRT( @DYALLOC.4620
*CALL ARGSIZE @DYALLOC.4621
*CALL ARGD1 @DYALLOC.4622
*CALL ARGDUMO @DYALLOC.4623
*CALL ARGPTRO @DYALLOC.4624
*CALL ARGOINDX ORH7F402.295
& ITT) @DYALLOC.4625
ENDIF DIAG_PRT.112
DIAG_PRT.113
ENDIF ! NERGY TIMESTEP DIAG_PRT.114
DIAG_PRT.115
RETURN DIAG_PRT.116
DIAG_PRT.117
END DIAG_PRT.118
*ENDIF @DYALLOC.4626