*IF DEF,CONTROL PRINTCT1.2
C ******************************COPYRIGHT****************************** GTS2F400.7597
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7598
C GTS2F400.7599
C Use, duplication or disclosure of this code is subject to the GTS2F400.7600
C restrictions as set forth in the contract. GTS2F400.7601
C GTS2F400.7602
C Meteorological Office GTS2F400.7603
C London Road GTS2F400.7604
C BRACKNELL GTS2F400.7605
C Berkshire UK GTS2F400.7606
C RG12 2SZ GTS2F400.7607
C GTS2F400.7608
C If no contract has been raised with this copy of the code, the use, GTS2F400.7609
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7610
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7611
C Modelling at the above address. GTS2F400.7612
C ******************************COPYRIGHT****************************** GTS2F400.7613
C GTS2F400.7614
CLL Routine: PRINTCTL ------------------------------------------------- PRINTCT1.3
CLL PRINTCT1.4
CLL Purpose: Outputs diagnostic printed output from primary model PRINTCT1.5
CLL data as zonal, quarter global and global mean quantities PRINTCT1.6
CLL in the case of the atmosphere; in a format yet to be PRINTCT1.7
CLL decided in the case of the ocean. PRINTCT1.8
CLL PRINTCT1.9
CLL Tested under compiler: cft77 PRINTCT1.10
CLL Tested under OS version: UNICOS 5.1 PRINTCT1.11
CLL PRINTCT1.12
CLL Author: T.C.Johns PRINTCT1.13
CLL PRINTCT1.14
CLL Model Modification history from model version 3.0: PRINTCT1.15
CLL version date PRINTCT1.16
CLL 3.1 3/02/93 : added comdeck CHSUNITS to define NUNITS for i/o RS030293.126
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.129
CLL portability. Author Tracey Smith. TS150793.130
CLL 3.3 08/02/94 Modify calls to TIME2SEC/SEC2TIME to output/input TJ080294.522
CLL elapsed times in days & secs, for portability. TCJ TJ080294.523
CLL 3.4 17/06/94 Argument LCAL360 added and passed to SEC2TIME GSS1F304.522
CLL S.J.Swarbrick GSS1F304.523
CLL 4.3 23/07/97 Disable this routine for MPP. To be enabled ARR0F403.44
CLL at a later version. R. Rawlins ARR0F403.45
CLL PRINTCT1.17
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) PRINTCT1.18
CLL PRINTCT1.19
CLL Logical components covered: C61 PRINTCT1.20
CLL PRINTCT1.21
CLL Project task: C61 PRINTCT1.22
CLL PRINTCT1.23
CLL External documentation: On-line UM documents C0 - The top-level PRINTCT1.24
CLL control system, and C61 - Zonal mean PRINTCT1.25
CLL calculations PRINTCT1.26
CLL PRINTCT1.27
CLL ------------------------------------------------------------------- PRINTCT1.28
C*L Interface and arguments: ------------------------------------------ PRINTCT1.29
C PRINTCT1.30
SUBROUTINE PRINTCTL ( 3,4@DYALLOC.2971
*CALL ARGSIZE 
@DYALLOC.2972
*CALL ARGD1 @DYALLOC.2973
*CALL ARGDUMA @DYALLOC.2974
*CALL ARGPTRA @DYALLOC.2975
*CALL ARGCONA @DYALLOC.2976
+ I_AO,MEANLEV,ICODE,CMESSAGE) GDR3F305.298
C PRINTCT1.32
IMPLICIT NONE PRINTCT1.33
@DYALLOC.2978
*CALL CMAXSIZE @DYALLOC.2979
*CALL TYPSIZE @DYALLOC.2980
*CALL TYPD1 @DYALLOC.2981
*CALL TYPDUMA @DYALLOC.2982
*CALL TYPPTRA @DYALLOC.2983
*CALL TYPCONA @DYALLOC.2984
@DYALLOC.2985
INTEGER I_AO ! IN - Atmosphere/ocean switch PRINTCT1.35
INTEGER MEANLEV ! IN - Mean level indicator PRINTCT1.36
INTEGER ICODE ! OUT - Error exit code PRINTCT1.37
CHARACTER*(80)CMESSAGE ! OUT - Error message TS150793.131
@DYALLOC.2986
C PRINTCT1.39
C*---------------------------------------------------------------------- PRINTCT1.40
C Common blocks PRINTCT1.41
*CALL CSUBMODL GDR3F305.299
C PRINTCT1.42
*CALL CHSUNITS RS030293.127
*CALL CHISTORY GDR3F305.300
*CALL CCONTROL GDR3F305.301
*CALL CTIME PRINTCT1.46
C PRINTCT1.47
C Subroutines called PRINTCT1.48
C PRINTCT1.49
*IF DEF,ATMOS PRINTCT1.50
EXTERNAL ZONMCTL,SEC2TIME,STP2TIME GDR3F305.302
C PRINTCT1.52
C Local variables PRINTCT1.53
C PRINTCT1.54
INTEGER PRINTCT1.55
& PERIOD_DAYS, ! Length of period for mean data, days TJ080294.524
& PERIOD_SECS, ! Length of period for mean data, secs TJ080294.525
& PERIOD, ! Length of period in dump multiples TJ080294.526
& END_DAYS, ! End of period for mean data, days TJ080294.527
& END_SECS, ! End of period for mean data, secs TJ080294.528
& START_YEAR, ! Start time for mean data PRINTCT1.57
& START_MONTH, ! Start time for mean data PRINTCT1.58
& START_DAY, ! Start time for mean data PRINTCT1.59
& START_HOUR, ! Start time for mean data PRINTCT1.60
& START_MINUTE, ! Start time for mean data PRINTCT1.61
& START_SECOND, ! Start time for mean data PRINTCT1.62
& START_DAYNO ! Start time for mean data PRINTCT1.63
CHARACTER*80 BANNER ! Descriptive banner for ZONM_ATM PRINTCT1.64
*ENDIF PRINTCT1.65
*IF DEF,ATMOS PRINTCT1.66
*IF DEF,MPP ARR0F403.46
ARR0F403.47
CL Force exit unconditionally: lower routines not yet converted to MPP. ARR0F403.48
IF(I_AO.GT.0) THEN ARR0F403.49
WRITE(6,*) 'PRINTCTL: Printing of climate global and zonal ', ARR0F403.50
& 'mean diagnostics disabled for MPP.' ARR0F403.51
WRITE(6,*) ' : Switch off request for printing in ', ARR0F403.52
& 'UMUI window atmos_Control_PostProc_DumpMean' ARR0F403.53
RETURN ARR0F403.54
ENDIF ARR0F403.55
*ENDIF ARR0F403.56
CL---------------------------------------------------------------------- PRINTCT1.67
CL 1. If atmosphere, execute zonal mean subroutine. PRINTCT1.68
CL PRINTCT1.69
IF ( I_AO .EQ. 1 .AND. P_LEVELS.LE.20) THEN PRINTCT1.70
CL PRINTCT1.71
CL 1.1 Generate a banner message to describe the data PRINTCT1.72
CL PRINTCT1.73
IF (MEANLEV.EQ.0) THEN ! Instantaneous data PRINTCT1.74
IF (STEPim(a_im).EQ.0) THEN ! Start fields GDR5F305.150
WRITE(BANNER,'('' ----------------- '',A4,A1, PRINTCT1.76
& '': Initial data valid at '', PRINTCT1.77
& I2,''Z '',I2,''/'',I2,''/'',I4, PRINTCT1.78
& '' -----------------'')') PRINTCT1.79
& EXPT_ID,JOB_ID,MODEL_BASIS_TIME(4),MODEL_BASIS_TIME(3) PRINTCT1.80
& ,MODEL_BASIS_TIME(2),MODEL_BASIS_TIME(1) PRINTCT1.81
ELSE ! Forecast fields PRINTCT1.82
WRITE(BANNER,'('' ---- '',A4,A1, PRINTCT1.83
& '': Forecast from Data Time '', PRINTCT1.84
& I2,''Z '',I2,''/'',I2,''/'',I4,'' Valid at '', PRINTCT1.85
& I2,''Z '',I2,''/'',I2,''/'',I4, PRINTCT1.86
& '' ---'')') PRINTCT1.87
& EXPT_ID,JOB_ID,MODEL_DATA_TIME(4),MODEL_DATA_TIME(3), PRINTCT1.88
& MODEL_DATA_TIME(2),MODEL_DATA_TIME(1), PRINTCT1.89
& I_HOUR,I_DAY,I_MONTH,I_YEAR PRINTCT1.90
ENDIF PRINTCT1.91
C PRINTCT1.92
ELSEIF (MEANLEV.EQ.-1) THEN ! Analysis fields PRINTCT1.93
WRITE(BANNER,'('' ------------------- '',A4,A1, PRINTCT1.94
& '': Analysis valid at '', PRINTCT1.95
& I2,''Z '',I2,''/'',I2,''/'',I4, PRINTCT1.96
& '' -------------------'')') PRINTCT1.97
& EXPT_ID,JOB_ID,I_HOUR,I_DAY,I_MONTH,I_YEAR PRINTCT1.98
C PRINTCT1.99
ELSEIF (MEANLEV.LE.4) THEN ! Mean data PRINTCT1.100
PERIOD=MEANFREQim(1,I_AO) GDR3F305.303
IF (MEANLEV.GT.1) PERIOD=PERIOD*MEANFREQim(2,I_AO) GDR3F305.304
IF (MEANLEV.GT.2) PERIOD=PERIOD*MEANFREQim(3,I_AO) GDR3F305.305
IF (MEANLEV.GT.3) PERIOD=PERIOD*MEANFREQim(4,I_AO) GDR3F305.306
CALL STP2TIME(PERIOD*DUMPFREQim(I_AO), GDR3F305.307
& STEPS_PER_PERIODim(I_AO),SECS_PER_PERIODim(I_AO), GDR3F305.308
& PERIOD_DAYS,PERIOD_SECS) TJ080294.530
CALL STP2TIME(STEPim(I_AO), GDR3F305.309
& STEPS_PER_PERIODim(I_AO),SECS_PER_PERIODim(I_AO), GDR3F305.310
& END_DAYS,END_SECS) TJ080294.532
CALL SEC2TIME(END_DAYS-PERIOD_DAYS,END_SECS-PERIOD_SECS, TJ080294.533
& BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.534
& START_YEAR,START_MONTH,START_DAY,START_HOUR, PRINTCT1.108
& START_MINUTE,START_SECOND,START_DAYNO,LCAL360) GSS1F304.526
WRITE(BANNER,'('' --- '',A4,A1,'': Period '',I1, PRINTCT1.110
& '' Time-mean fields from '', PRINTCT1.111
& I2,''Z '',I2,''/'',I2,''/'',I4,'' to '', PRINTCT1.112
& I2,''Z '',I2,''/'',I2,''/'',I4,'' ----'')') PRINTCT1.113
& EXPT_ID,JOB_ID,MEANLEV, PRINTCT1.114
& START_HOUR,START_DAY,START_MONTH,START_YEAR, PRINTCT1.115
& I_HOUR,I_DAY,I_MONTH,I_YEAR PRINTCT1.116
C PRINTCT1.117
ELSE ! Bad value for MEANLEV PRINTCT1.118
CMESSAGE='PRINTCTL : Illegal value of MEANLEV' PRINTCT1.119
ICODE=1 PRINTCT1.120
GOTO 999 PRINTCT1.121
ENDIF PRINTCT1.122
CL PRINTCT1.123
CL 1.2 Call the zonal mean print control routine PRINTCT1.124
CL PRINTCT1.125
CALL ZONMCTL ( @DYALLOC.2987
*CALL ARGSIZE @DYALLOC.2988
*CALL ARGD1 @DYALLOC.2989
*CALL ARGDUMA @DYALLOC.2990
*CALL ARGPTRA @DYALLOC.2991
*CALL ARGCONA @DYALLOC.2992
* BANNER, NF171193.81
* P_FIELD, ! for dynamic array NF171193.82
* P_LEVELS, ! for dynamic array NF171193.83
& ST_LEVELS, ! for dynamic array AJS1F401.1596
& SM_LEVELS, ! for dynamic array AJS1F401.1597
* U_FIELD, ! for dynamic array NF171193.85
* Q_LEVELS, ! for dynamic array NF171193.86
* ICODE, CMESSAGE) NF171193.87
IF (ICODE.GT.0) GOTO 999 PRINTCT1.128
ENDIF PRINTCT1.129
*ENDIF PRINTCT1.130
*IF DEF,OCEAN PRINTCT1.131
CL---------------------------------------------------------------------- PRINTCT1.132
CL 2. If ocean, print standard ocean diagnostics from primary fields PRINTCT1.133
CL (no code currently implemented as printed ocean diagnostics are PRINTCT1.134
CL handled within the ocean basecode) PRINTCT1.135
CL PRINTCT1.136
IF (I_AO.EQ.2) THEN PRINTCT1.137
ICODE=-1 PRINTCT1.138
CMESSAGE= PRINTCT1.139
& "PRINTCTL : Warning - printed ocean diagnostics not implemented" PRINTCT1.140
WRITE(6,*)CMESSAGE GIE0F403.556
ENDIF PRINTCT1.142
*ENDIF PRINTCT1.143
C PRINTCT1.144
999 CONTINUE PRINTCT1.145
RETURN PRINTCT1.146
CL---------------------------------------------------------------------- PRINTCT1.147
END PRINTCT1.148
*ENDIF PRINTCT1.149