File indexing completed on 2018-03-02 18:38:16 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
0003 subroutine cal_PrintError(
0004 I calerr,
0005 I mythid
0006 & )
0007
0008
0009
0010
0011
d659697902 Patr*0012
a63ed37559 Patr*0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041
0042
0043
0044
0045
0046
0047
0048
0049
0050
0051
0052
0053
0054
0055
0056
0057
0058
0059
0060
0061
0062
0063
0064
0065
0066
0067
0068
0069
0070
0071
0072
0073
0074 implicit none
0075
087901a8ca Jean*0076
a63ed37559 Patr*0077
0078 #include "EEPARAMS.h"
c34cc926ff Patr*0079 #include "SIZE.h"
0080 #include "PARAMS.h"
a63ed37559 Patr*0081
087901a8ca Jean*0082
a63ed37559 Patr*0083
087901a8ca Jean*0084
0085
a63ed37559 Patr*0086
0087 integer mythid
0088 integer calerr
0089
087901a8ca Jean*0090
a63ed37559 Patr*0091
0092 integer nroutine
0093 integer nerrcode
0094 logical missingerrcode
c34cc926ff Patr*0095 CHARACTER*(MAX_LEN_MBUF) msgBuf
a63ed37559 Patr*0096
087901a8ca Jean*0097
a63ed37559 Patr*0098
0099 nerrcode = mod(calerr,100)
0100 nroutine = (calerr - nerrcode)/100
0101 missingerrcode = .false.
0102
087901a8ca Jean*0103
0104
a63ed37559 Patr*0105
087901a8ca Jean*0106
0107
0108
0109
0110
0111
0112
0113
0114
0115
a63ed37559 Patr*0116
087901a8ca Jean*0117
0118 if (nroutine .eq. 1) then
0119
a63ed37559 Patr*0120
0121 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0122 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0123 & ' cal_Set: No appropriate calendar has been specified.'
c34cc926ff Patr*0124 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0125 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0126 else if (nerrcode .eq. 2) then
a8259b3bc9 Jean*0127 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0128 & ' cal_Set: The time step specified is not valid.'
c34cc926ff Patr*0129 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0130 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0131 else if (nerrcode .eq. 3) then
a8259b3bc9 Jean*0132 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0133 & ' cal_Set: The time step is less than a second.'
c34cc926ff Patr*0134 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0135 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0136 else if (nerrcode .eq. 4) then
a8259b3bc9 Jean*0137 WRITE(msgBuf,'(A)')
c34cc926ff Patr*0138 & ' cal_Set: The time step contains fractions of a second.'
0139 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0140 CALL PRINT_ERROR( msgBuf , 1)
a8259b3bc9 Jean*0141
0142
0143
0144
0145
0146
0147
0148
0149
0150
0151
0152
0153
0154
0155
0156
0157
0158
0159
0160
0161
0162
0163
0164
0165
0166
0167
0168
0169
0170
0171
0172
0173
0174
0175
0176
0177
0178
0179
0180
0181
0182
0183
0184
0185
0186
0187
0188
0189
0190
0191
0192
0193
0194
0195
0196
0197
0198
0199
0200
0201
a63ed37559 Patr*0202 else
0203 missingerrcode = .true.
0204 endif
0205
0206 else if (nroutine .eq. 2) then
087901a8ca Jean*0207
a63ed37559 Patr*0208
0209 missingerrcode = .true.
0210
0211 else if (nroutine .eq. 3) then
087901a8ca Jean*0212
a63ed37559 Patr*0213
0214 missingerrcode = .true.
0215
0216 else if (nroutine .eq. 4) then
087901a8ca Jean*0217
a63ed37559 Patr*0218
0219 missingerrcode = .true.
0220
0221 else if (nroutine .eq. 5) then
087901a8ca Jean*0222
a63ed37559 Patr*0223
0224 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0225 WRITE(msgBuf,'(A)')
c34cc926ff Patr*0226 & 'cal_TimePassed: cal and timeinterval cannot be compared'
0227 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0228 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0229 else
0230 missingerrcode = .true.
0231 endif
0232
0233 else if (nroutine .eq. 6) then
087901a8ca Jean*0234
a63ed37559 Patr*0235
0236 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0237 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0238 & ' cal_AddTime: not a valid time interval.'
c34cc926ff Patr*0239 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0240 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0241 else
0242 missingerrcode = .true.
0243 endif
0244
0245 else if (nroutine .eq. 7) then
087901a8ca Jean*0246
a63ed37559 Patr*0247
0248 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0249 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0250 & ' cal_TimeInterval: not a valid time unit.'
c34cc926ff Patr*0251 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0252 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0253 else
0254 missingerrcode = .true.
0255 endif
0256
0257 else if (nroutine .eq. 8) then
087901a8ca Jean*0258
a63ed37559 Patr*0259
0260 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0261 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0262 & ' cal_SubDates: Not a valid combination of calendar dates'
c34cc926ff Patr*0263 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0264 CALL PRINT_ERROR( msgBuf , 1)
a8259b3bc9 Jean*0265 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0266 & ' or time intervals.'
c34cc926ff Patr*0267 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0268 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0269 else
0270 missingerrcode = .true.
0271 endif
0272
0273 else if (nroutine .eq. 9) then
087901a8ca Jean*0274
a63ed37559 Patr*0275
0276 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0277 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0278 & ' cal_ConvDate: date specification has mixed signs.'
c34cc926ff Patr*0279 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0280 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0281 else
0282 missingerrcode = .true.
0283 endif
0284
0285 else if (nroutine .eq. 10) then
087901a8ca Jean*0286
a63ed37559 Patr*0287
0288 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0289 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0290 & ' cal_ToSeconds: input not a time interval array.'
c34cc926ff Patr*0291 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0292 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0293 else
0294 missingerrcode = .true.
0295 endif
0296
0297 else if (nroutine .eq. 11) then
087901a8ca Jean*0298
a63ed37559 Patr*0299
0300 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0301 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0302 & ' cal_StepsPerDay: nothing else to do.'
c34cc926ff Patr*0303 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0304 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0305 else
0306 missingerrcode = .true.
0307 endif
0308
0309 else if (nroutine .eq. 12) then
087901a8ca Jean*0310
a63ed37559 Patr*0311
0312 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0313 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0314 & ' cal_DaysPerMonth: current year after final year.'
c34cc926ff Patr*0315 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0316 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0317 else
0318 missingerrcode = .true.
0319 endif
0320
0321 else if (nroutine .eq. 13) then
087901a8ca Jean*0322
a63ed37559 Patr*0323
0324 missingerrcode = .true.
0325
0326 else if (nroutine .eq. 14) then
087901a8ca Jean*0327
a63ed37559 Patr*0328
0329 missingerrcode = .true.
0330
0331 else if (nroutine .eq. 15) then
087901a8ca Jean*0332
a63ed37559 Patr*0333
0334 missingerrcode = .true.
0335
0336 else if (nroutine .eq. 16) then
087901a8ca Jean*0337
a63ed37559 Patr*0338
0339 missingerrcode = .true.
0340
0341 else if (nroutine .eq. 17) then
087901a8ca Jean*0342
a63ed37559 Patr*0343
0344 missingerrcode = .true.
0345
0346 else if (nroutine .eq. 18) then
087901a8ca Jean*0347
a63ed37559 Patr*0348
0349 if (nerrcode .eq. 0) then
a8259b3bc9 Jean*0350 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0351 & ' cal_CheckDate: A valid date specification!'
c34cc926ff Patr*0352 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0353 CALL PRINT_ERROR( msgBuf , 1)
a8259b3bc9 Jean*0354 WRITE(msgBuf,'(A)')
1cc1e58e5f Patr*0355 & ' This only means that the format is ok'
c34cc926ff Patr*0356 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0357 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0358 else if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0359 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0360 & ' cal_CheckDate: Last component of array not valid!'
c34cc926ff Patr*0361 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0362 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0363 else if (nerrcode .eq. 2) then
a8259b3bc9 Jean*0364 WRITE(msgBuf,'(A)')
c34cc926ff Patr*0365 & ' cal_CheckDate: Third component of interval array not 0'
0366 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0367 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0368 else if (nerrcode .eq. 3) then
a8259b3bc9 Jean*0369 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0370 & ' cal_CheckDate: Signs of first two components unequal!'
c34cc926ff Patr*0371 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0372 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0373 else if (nerrcode .eq. 4) then
a8259b3bc9 Jean*0374 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0375 & ' cal_CheckDate: Second component not in hhmmss format!'
c34cc926ff Patr*0376 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0377 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0378 else if (nerrcode .eq. 5) then
a8259b3bc9 Jean*0379 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0380 & ' cal_CheckDate: Weekday indentifier not correct!'
c34cc926ff Patr*0381 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0382 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0383 else if (nerrcode .eq. 6) then
a8259b3bc9 Jean*0384 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0385 & ' cal_CheckDate: Leap year identifier not correct!'
c34cc926ff Patr*0386 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0387 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0388 else if (nerrcode .eq. 7) then
a8259b3bc9 Jean*0389 WRITE(msgBuf,'(A)')
c34cc926ff Patr*0390 & 'cal_CheckDate: Calendar date before predef. reference date'
0391 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0392 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0393 else if (nerrcode .eq. 8) then
a8259b3bc9 Jean*0394 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0395 & ' cal_CheckDate: First component not in yymmdd format!'
c34cc926ff Patr*0396 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0397 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0398 else
0399 missingerrcode = .true.
0400 endif
0401
0402 else if (nroutine .eq. 19) then
087901a8ca Jean*0403
a63ed37559 Patr*0404
0405 missingerrcode = .true.
0406
0407 else if (nroutine .eq. 20) then
087901a8ca Jean*0408
a63ed37559 Patr*0409
0410 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0411 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0412 & ' cal_PrintDate: date not a legal calendar array.'
c34cc926ff Patr*0413 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0414 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0415 else
0416 missingerrcode = .true.
0417 endif
0418
0419 else if (nroutine .eq. 21) then
087901a8ca Jean*0420
a63ed37559 Patr*0421
0422 missingerrcode = .true.
0423
0424 else if (nroutine .eq. 25) then
087901a8ca Jean*0425
a63ed37559 Patr*0426
0427 if (nerrcode .eq. 1) then
a8259b3bc9 Jean*0428 WRITE(msgBuf,'(A)')
a63ed37559 Patr*0429 & ' cal_NumInts: Expected a time interval as third argument.'
c34cc926ff Patr*0430 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
0431 CALL PRINT_ERROR( msgBuf , 1)
a63ed37559 Patr*0432 else
0433 missingerrcode = .true.
0434 endif
0435
0436 else
0437 missingerrcode = .true.
0438 endif
0439
0440 if (missingerrcode) then
0441 print*,' cal_PrintError: routine called by an undefined'
0442 print*,' error code.'
0443 print*,' cal_PrintError: error code = ',calerr
0444 stop ' stopped in cal_PrintError.'
0445 endif
0446
0447 return
0448 end