SUBROUTINE ENG_CTL( INT14,TEMP_CORR_RATE, 1,5ENG_CTL1.27
*CALL ARGSIZE 
ENG_CTL1.28
*CALL ARGD1 ENG_CTL1.29
*CALL ARGDUMA ENG_CTL1.30
*CALL ARGDUMO ENG_CTL1.31
*CALL ARGDUMW GKR1F401.200
*CALL ARGSTS ENG_CTL1.32
*CALL ARGPTRA ENG_CTL1.33
*CALL ARGPTRO ENG_CTL1.34
*CALL ARGCONA ENG_CTL1.35
*CALL ARGPPX GKR0F305.923
& ICODE,CMESSAGE ) ENG_CTL1.36
ENG_CTL1.37
IMPLICIT NONE ENG_CTL1.38
ENG_CTL1.39
REAL ENG_CTL1.40
& TEMP_CORR_RATE ! Global mean temperature correction (K/s) ENG_CTL1.41
ENG_CTL1.42
INTEGER ENG_CTL1.43
& INT14, ! Dummy variable for STASH_MAXLEN(14) ENG_CTL1.44
& ICODE ! Return code : 0 Normal Exit ENG_CTL1.45
ENG_CTL1.46
CHARACTER*(80) ENG_CTL1.47
& CMESSAGE ! Error message if return code >0 ENG_CTL1.48
ENG_CTL1.49
*CALL CMAXSIZE ENG_CTL1.50
*CALL CSUBMODL GSS1F305.925
*CALL TYPSIZE ENG_CTL1.51
*CALL TYPD1 ENG_CTL1.52
*CALL TYPDUMA ENG_CTL1.53
*CALL TYPDUMO ENG_CTL1.54
*CALL TYPDUMW GKR1F401.201
*CALL TYPSTS ENG_CTL1.55
*CALL TYPPTRA ENG_CTL1.56
*CALL TYPPTRO ENG_CTL1.57
*CALL TYPCONA ENG_CTL1.58
*CALL PPXLOOK GKR0F305.924
ENG_CTL1.59
*CALL CHSUNITS ENG_CTL1.61
*CALL CCONTROL ENG_CTL1.62
*CALL C_R_CP ENG_CTL1.63
*CALL C_G ENG_CTL1.64
ENG_CTL1.65
CL External subroutines called ENG_CTL1.66
ENG_CTL1.67
EXTERNAL ENG_CTL1.68
& TIMER,STASH ENG_CTL1.69
ENG_CTL1.70
CL Dynamically allocated area for stash processing ENG_CTL1.71
ENG_CTL1.72
REAL ENG_CTL1.73
& STASHWORK(INT14) ENG_CTL1.74
ENG_CTL1.75
C Local variables ENG_CTL1.76
ENG_CTL1.77
INTEGER ENG_CTL1.78
& I ENG_CTL1.79
& ,IM_IDENT ! internal model identifier GRB4F305.125
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.126
ENG_CTL1.80
CL ENG_CTL1.81
CL--- SECTION 14 --- ENERGY CORRECTION DIAGNOSTIC(S) --- ENG_CTL1.82
CL ENG_CTL1.83
ENG_CTL1.84
IF(LTIMER) THEN ENG_CTL1.85
CALL TIMER('ENG_CTL ',3) ENG_CTL1.86
END IF ENG_CTL1.87
GRB4F305.127
C Set up internal model identifier and STASH index GRB4F305.128
im_ident = atmos_im GRB4F305.129
im_index = internal_model_index(im_ident) GRB4F305.130
ENG_CTL1.88
CMESSAGE=' ' ENG_CTL1.89
ICODE=0 ENG_CTL1.90
ENG_CTL1.91
C Broadcast temperature correction rate from scalar to full field ENG_CTL1.92
C and multiply up by column mass weighting factor to convert to flux ENG_CTL1.93
ENG_CTL1.94
IF (SF(201,14)) THEN ENG_CTL1.95
DO I=1,P_FIELD ENG_CTL1.96
STASHWORK(SI(201,14,im_index)+I-1)= GRB4F305.131
& (CP/G)*TEMP_CORR_RATE*D1(JPSTAR+I-1) GRB4F305.132
END DO ENG_CTL1.98
ENDIF ENG_CTL1.99
ENG_CTL1.100
C call STASH to process output ENG_CTL1.101
ENG_CTL1.102
IF(LTIMER) THEN ENG_CTL1.103
CALL TIMER('STASH ',3) ENG_CTL1.104
END IF ENG_CTL1.105
ENG_CTL1.106
CALL STASH(a_sm,a_im,14,STASHWORK, GKR0F305.925
*CALL ARGSIZE ENG_CTL1.108
*CALL ARGD1 ENG_CTL1.109
*CALL ARGDUMA ENG_CTL1.110
*CALL ARGDUMO ENG_CTL1.111
*CALL ARGDUMW GKR1F401.202
*CALL ARGSTS ENG_CTL1.112
*CALL ARGPPX GKR0F305.926
& ICODE,CMESSAGE) ENG_CTL1.116
ENG_CTL1.117
IF(LTIMER) THEN ENG_CTL1.118
CALL TIMER('STASH ',4) ENG_CTL1.119
END IF ENG_CTL1.120
ENG_CTL1.121
IF(LTIMER) THEN ENG_CTL1.122
CALL TIMER('ENG_CTL ',4) ENG_CTL1.123
END IF ENG_CTL1.124
ENG_CTL1.125
RETURN ENG_CTL1.126
END ENG_CTL1.127
ENG_CTL1.128
C ----------------------------------------------------- ENG_CTL1.129
ENG_CTL1.130
*ENDIF ENG_CTL1.131