SUBROUTINE TIMSER(CMESSAGE,ErrorStatus) 1TIMSER1.5
IMPLICIT NONE TIMSER1.6
TIMSER1.7
! Description: TIMSER1.8
! TIMSER1.9
! Method: TIMSER1.10
! TIMSER1.11
! Current code owner: S.J.Swarbrick TIMSER1.12
! TIMSER1.13
! History: TIMSER1.14
! Version Date Comment TIMSER1.15
! ======= ==== ======= TIMSER1.16
! 4.0 Sept. 95 Original code. S.J.Swarbrick TIMSER1.17
! 4.1 Apr. 96 Rationalise MDI S.J.Swarbrick GSS1F401.39
! TIMSER1.18
! Code description: TIMSER1.19
! FORTRAN 77 + common Fortran 90 extensions. TIMSER1.20
! Written to UM programming standards version 7. TIMSER1.21
! TIMSER1.22
! System component covered: TIMSER1.23
! System task: Sub-Models Project TIMSER1.24
! TIMSER1.25
! Global variables: TIMSER1.26
*CALL LENFIL 
TIMSER1.27
*CALL CSUBMODL TIMSER1.28
*CALL VERSION TIMSER1.29
*CALL TYPSIZE GSS1F401.40
*CALL MODEL TIMSER1.30
*CALL CSTASH GRB0F401.23
*CALL STEXTEND TIMSER1.32
*CALL C_MDI GSS1F401.41
TIMSER1.33
! Subroutine arguments TIMSER1.34
! Scalar arguments with intent(out): TIMSER1.35
CHARACTER*80 CMESSAGE ! Error return message TIMSER1.36
TIMSER1.37
! Error status: TIMSER1.38
INTEGER ErrorStatus ! Error return code TIMSER1.39
TIMSER1.40
! Local variables: TIMSER1.41
INTEGER BlkId !Time series block identifier TIMSER1.42
INTEGER BlkSt !Start position of ts block data TIMSER1.43
INTEGER Nrecs_prev !No of recs in previous time ser block TIMSER1.44
INTEGER IDP !Domain profile loop counter TIMSER1.45
INTEGER IPOS !Position in ts limits arrays TIMSER1.46
INTEGER ISBLIM,ISTLIM !Used for converting vertical ts TIMSER1.47
INTEGER IB,IT,IL,ILVL ! domain limits to sequence nos. TIMSER1.48
TIMSER1.49
!- End of Header ------------------------------------------------------ TIMSER1.50
TIMSER1.51
!Loop over domain profiles TIMSER1.52
BlkSt =1 TIMSER1.53
DO IDP=1,NDPROF TIMSER1.54
IF(NPOS_TS(IDP).GT.0) THEN TIMSER1.55
! This domain profile has a time series TIMSER1.56
! Identify TS block using pointer array TIMSER1.57
BlkId = NPOS_TS (IDP) TIMSER1.58
! Find start position (in LIM_TS arrays) of data for this block TIMSER1.59
IF (BlkId.GT.1) THEN TIMSER1.60
BlkSt=BlkSt+Nrecs_prev TIMSER1.61
END IF TIMSER1.62
! Loop over records in ts block corresponding to domain profile IDP. TIMSER1.63
! Adjust the TS records for domain profiles with vertical or horiz TIMSER1.64
! averaging. TIMSER1.65
! Convert the ts domain vertical limits to sequence nos. TIMSER1.66
! in the domain profile levels range/levels list. TIMSER1.67
DO IPOS=BlkSt,BlkSt+NRECS_TS(NPOS_TS(IDP))-1 TIMSER1.68
! Vertical levels TIMSER1.69
IF(IOPL_D(IDP).EQ.1 .OR. IOPL_D(IDP).EQ.2 .OR. TIMSER1.70
& IOPL_D(IDP).EQ.6) THEN TIMSER1.71
! Model levels TIMSER1.72
IF(IMN_D(IDP).EQ.1) THEN TIMSER1.73
! Vertical mean TIMSER1.74
BLIM_TS(IPOS)=1 TIMSER1.75
TLIM_TS(IPOS)=1 TIMSER1.76
ELSE TIMSER1.77
! No vertical mean TIMSER1.78
IF(LEVB_D(IDP).GE.0) THEN TIMSER1.79
! Range of model levels TIMSER1.80
IF(BLIM_TS(IPOS).LT.LEVB_D(IDP) .OR. TIMSER1.81
& TLIM_TS(IPOS).GT.LEVT_D(IDP)) THEN TIMSER1.82
WRITE(6,*) 'ERROR, TIMSER: ', TIMSER1.83
& ' TS_DOMAIN LEVEL LIMIT OUT OF RANGE; ', TIMSER1.84
& ' DOM PROF: ',IDP, GSS1F401.42
& ' TS RECORD: ',IPOS TIMSER1.86
ErrorStatus=1 TIMSER1.87
CMESSAGE='TS DOMAIN LEVEL LIMIT OUT OF RANGE' TIMSER1.88
GO TO 999 TIMSER1.89
END IF TIMSER1.90
BLIM_TS(IPOS)=BLIM_TS(IPOS)-LEVB_D(IDP)+1 TIMSER1.91
TLIM_TS(IPOS)=TLIM_TS(IPOS)-LEVB_D(IDP)+1 TIMSER1.92
ELSE TIMSER1.93
! List of selected model levels; TIMSER1.94
! LEVT_D(IDP)=no. of levels in list TIMSER1.95
ISBLIM=IMDI GSS1F401.43
ISTLIM=IMDI GSS1F401.44
DO IL=1,LEVT_D(IDP) TIMSER1.98
IF(BLIM_TS(IPOS).EQ.LEVLST_D(IL,IDP)) ISBLIM=IL TIMSER1.99
IF(TLIM_TS(IPOS).EQ.LEVLST_D(IL,IDP)) ISTLIM=IL TIMSER1.100
END DO TIMSER1.101
IF((ISTLIM.EQ.IMDI).OR. GSS1F401.45
& (ISBLIM.EQ.IMDI)) THEN GSS1F401.46
WRITE(6,*) TIMSER1.104
& 'ERROR TIMSER:T-SERIES INTEGER LEVEL NOT IN ', TIMSER1.105
& 'LEVELS LIST; DOM PROF: ',IDP,' TS RECORD: ',IPOS TIMSER1.106
WRITE(6,*) 'SPECIFIED TS LEVELS LIMITS: ', TIMSER1.107
& BLIM_TS(IPOS),TLIM_TS(IPOS) TIMSER1.108
ErrorStatus = 1 TIMSER1.109
CMESSAGE= TIMSER1.110
& 'ERROR TIMSER:T-SERIES LEVEL NOT IN LEVELS LIST' TIMSER1.111
GO TO 999 TIMSER1.112
END IF TIMSER1.113
! Store seq. nos. of ts domain level limits TIMSER1.114
BLIM_TS(IPOS)=ISBLIM TIMSER1.115
TLIM_TS(IPOS)=ISTLIM TIMSER1.116
END IF TIMSER1.117
END IF TIMSER1.118
! List of specified real levels TIMSER1.119
ELSE IF((IOPL_D(IDP).NE.5).AND.(IOPL_D(IDP).LE.9)) THEN TIMSER1.120
IF(IMN_D(IDP).EQ.1) THEN TIMSER1.121
BLIM_TS(IPOS)=1 TIMSER1.122
TLIM_TS(IPOS)=1 TIMSER1.123
ELSE TIMSER1.124
! Determine sequence nos. of top & bottom ts domain TIMSER1.125
! levels in real levels list (ISBLIM, ISTLIM), by TIMSER1.126
! representing real level values as integers. TIMSER1.127
ISBLIM=IMDI GSS1F401.47
ISTLIM=IMDI GSS1F401.48
IB=(BLIMR_TS(IPOS)*1000.+0.5) TIMSER1.130
IT=(TLIMR_TS(IPOS)*1000.+0.5) TIMSER1.131
DO IL=1,LEVT_D(IDP) TIMSER1.132
ILVL=(RLEVLST_D(IL,IDP)*1000.+0.5) TIMSER1.133
IF(IB.EQ.ILVL) ISBLIM=IL TIMSER1.134
IF(IT.EQ.ILVL) ISTLIM=IL TIMSER1.135
END DO TIMSER1.136
IF((ISTLIM.EQ.IMDI).OR. GSS1F401.49
& (ISBLIM.EQ.IMDI)) THEN GSS1F401.50
WRITE(6,*) TIMSER1.139
& 'ERROR TIMSER:T-SERIES REAL LEVEL NOT IN ', TIMSER1.140
& 'LEVELS LIST; DOM PROF: ',IDP,' TS RECORD: ',IPOS TIMSER1.141
WRITE(6,*) 'SPECIFIED TS LEVELS LIMITS: ', TIMSER1.142
& BLIMR_TS(IPOS),TLIMR_TS(IPOS) TIMSER1.143
ErrorStatus = 1 TIMSER1.144
CMESSAGE= TIMSER1.145
& 'ERROR TIMSER:T-SERIES LEVEL NOT IN LEVELS LIST' TIMSER1.146
END IF TIMSER1.147
! Store seq. nos. of ts domain level limits TIMSER1.148
BLIM_TS(IPOS)=ISBLIM TIMSER1.149
TLIM_TS(IPOS)=ISTLIM TIMSER1.150
END IF TIMSER1.151
ELSE IF(IOPL_D(IDP).EQ.5) THEN TIMSER1.152
! Single level TIMSER1.153
BLIM_TS(IPOS)=1 TIMSER1.154
TLIM_TS(IPOS)=1 TIMSER1.155
ELSE TIMSER1.156
WRITE(6,*) TIMSER1.157
& 'ERROR TIMSER: UNEXPECTED LEVEL TYPE CODE',IOPL_D(IDP) TIMSER1.158
ErrorStatus=1 TIMSER1.159
GO TO 999 TIMSER1.160
END IF TIMSER1.161
! Horizontal area TIMSER1.162
IF(IMN_D(IDP).EQ.2) THEN TIMSER1.163
ELIM_TS(IPOS)=1 TIMSER1.164
WLIM_TS(IPOS)=1 TIMSER1.165
ELSE IF(IMN_D(IDP).EQ.3) THEN TIMSER1.166
NLIM_TS(IPOS)=1 TIMSER1.167
SLIM_TS(IPOS)=1 TIMSER1.168
ELSE IF(IMN_D(IDP).EQ.4) THEN TIMSER1.169
ELIM_TS(IPOS)=1 TIMSER1.170
WLIM_TS(IPOS)=1 TIMSER1.171
NLIM_TS(IPOS)=1 TIMSER1.172
SLIM_TS(IPOS)=1 TIMSER1.173
END IF TIMSER1.174
IG_TS =0 ! These constants are left-overs from the TIMSER1.175
I1_TS =1 ! pre-vn3.5 TIMSER routine: they are used TIMSER1.176
I51_TS=51 ! in the UM time-series routines. TIMSER1.177
END DO ! IPOS loop TIMSER1.178
Nrecs_prev=NRECS_TS(NPOS_TS(IDP)) ! For next TS block TIMSER1.179
END IF ! TS(IDP).EQ.'Y' TIMSER1.180
END DO ! IDP loop TIMSER1.181
TIMSER1.182
999 RETURN TIMSER1.183
END TIMSER1.184
*ENDIF TIMSER1.185