SUBROUTINE PRINTCAM(ihdr,rhdr,nint,nreal,k,nftout,err,cmessage) 1,2PRINTCAM.34
PRINTCAM.35
IMPLICIT NONE PRINTCAM.36
PRINTCAM.37
INTEGER PRINTCAM.38
& nreal ! IN no of real words PRINTCAM.39
& ,nint ! IN no of integer words PRINTCAM.40
& ,ihdr(nint) ! IN integer part of header PRINTCAM.41
& ,k ! Position of record in file PRINTCAM.42
& ,nftout ! Output file unit no PRINTCAM.43
INTEGER err ! error code PRINTCAM.44
CHARACTER*40 CMESSAGE ! error message PRINTCAM.45
PRINTCAM.46
REAL PRINTCAM.47
& RHDR(NREAL) !IN real header PRINTCAM.48
PRINTCAM.49
external julday PRINTCAM.50
integer julday PRINTCAM.51
PRINTCAM.52
C*---------------------------------------------------------------------- PRINTCAM.53
C*L Local variables:--------------------------------------------------- PRINTCAM.54
PRINTCAM.55
integer lrec ! the record length PRINTCAM.56
integer ibb ! code for the type of calendar PRINTCAM.57
real PRINTCAM.58
& stime, ! the start time in "julian" days PRINTCAM.59
& etime, ! the end time in "julian" days PRINTCAM.60
& ltime, ! the processing period. PRINTCAM.61
& z ! the vertical co-ordinate PRINTCAM.62
PRINTCAM.63
C*---------------------------------------------------------------------- PRINTCAM.64
PRINTCAM.65
CL 1. Print out integer and real header. PRINTCAM.66
Cl The words that we need from the header are as follows: PRINTCAM.67
CL LBYR integer 1 \ PRINTCAM.68
CL LBMON integer 2 \ PRINTCAM.69
CL LBDAT integer 3 - forms stime (julian days) PRINTCAM.70
CL LBHR integer 4 / PRINTCAM.71
CL LBMIN integer 5 / PRINTCAM.72
PRINTCAM.73
CL LBYRD integer 7 \ PRINTCAM.74
CL LBMOND integer 8 \ PRINTCAM.75
CL LBDATD integer 9 - forms etime (julian days) PRINTCAM.76
CL LBHRD integer 10 / PRINTCAM.77
CL LBMIND integer 1 / PRINTCAM.78
PRINTCAM.79
CL lBTim integer 13 PRINTCAM.80
CL LBLREC lbrow*lbnpt+lbext (integer 20) PRINTCAM.81
CL lbcode integer 16 PRINTCAM.82
PRINTCAM.83
CL lbhem integer 17 PRINTCAM.84
CL LBROW integer 18 PRINTCAM.85
CL LBNPT integer 19 PRINTCAM.86
PRINTCAM.87
CL LBFC integer 23 PRINTCAM.88
CL LBCFC integer 24 PRINTCAM.89
CL LBPROC integer 25 PRINTCAM.90
PRINTCAM.91
CL LBVC integer 26 PRINTCAM.92
CL LBRVC integer 27 PRINTCAM.93
PRINTCAM.94
CL LBLEV integer 33 PRINTCAM.95
PRINTCAM.96
CL lbsrce integer 38 PRINTCAM.97
CL LBUSER(4) -- stash integer 42 PRINTCAM.98
CL LBUSER(5) -- pseudolevel integer 43 PRINTCAM.99
PRINTCAM.100
CL brsvd(1) -- bulev real 46 PRINTCAM.101
CL brsvd(2) -- bhlev real 47 PRINTCAM.102
PRINTCAM.103
CL bdataum real 50 PRINTCAM.104
CL bacc real 51 PRINTCAM.105
PRINTCAM.106
CL BLEV real 52 PRINTCAM.107
CL BRLEV real 53 PRINTCAM.108
CL BHLEV real 54 PRINTCAM.109
CL BHRLEV real 55 PRINTCAM.110
PRINTCAM.111
CL bplat real 56 PRINTCAM.112
CL bplon real 57 PRINTCAM.113
PRINTCAM.114
CL BGOR real 58 PRINTCAM.115
Cl BZY real 59 PRINTCAM.116
CL BDY real 60 PRINTCAM.117
CL BZX real 61 PRINTCAM.118
CL BDX real 62 PRINTCAM.119
PRINTCAM.120
CL BMDI real 64 PRINTCAM.121
err=0 ! no errors (yet) PRINTCAM.122
lrec=ihdr(18)*ihdr(19) PRINTCAM.123
if (ihdr(20).gt.0) then PRINTCAM.124
lrec=lrec+ihdr(20) PRINTCAM.125
endif PRINTCAM.126
PRINTCAM.127
C ============================================================ PRINTCAM.128
C compute derived functions PRINTCAM.129
C ============================================================ PRINTCAM.130
ibb=mod(ihdr(13)/10,10) PRINTCAM.131
PRINTCAM.132
if (mod(ihdr(13),10).eq.1) then ! use julian calendar PRINTCAM.133
stime=julday
(ihdr(1),ihdr(2),ihdr(3),err,cmessage)*1.0 PRINTCAM.134
if (err.ne.0) return ! got an error so return to calling rout PRINTCAM.135
etime=julday(ihdr(7),ihdr(8),ihdr(9),err,cmessage)*1.0 PRINTCAM.136
if (err.ne.0) return ! got an error so return to calling rout PRINTCAM.137
else ! use model 360 day calendar PRINTCAM.138
stime=(ihdr(1)*12.0+(ihdr(2)-1))*30.0+(ihdr(3)-1) PRINTCAM.139
etime=(ihdr(7)*12.0+(ihdr(8)-1))*30.0+(ihdr(9)-1) PRINTCAM.140
endif PRINTCAM.141
stime=stime+(ihdr(4)+ihdr(5)/60.0)/24.0 ! fractional day PRINTCAM.142
etime=etime+(ihdr(10)+ihdr(11)/60.0)/24.0 ! fractional day PRINTCAM.143
if (ibb.eq.2.or.ibb.eq.3) then PRINTCAM.144
ltime=etime-stime PRINTCAM.145
else PRINTCAM.146
ltime=0 PRINTCAM.147
endif PRINTCAM.148
PRINTCAM.149
CLL ============================================================ PRINTCAM.150
CLL Calculate the physical vertical coordinate PRINTCAM.151
CLL ============================================================ PRINTCAM.152
if (ihdr(26).eq.9) then PRINTCAM.153
z=rhdr(54)/1e5+rhdr(52) PRINTCAM.154
else PRINTCAM.155
z=rhdr(52) PRINTCAM.156
endif PRINTCAM.157
PRINTCAM.158
write(nftout,1000) PRINTCAM.159
& k,ihdr(45), ! record pos, model_code PRINTCAM.160
& stime,ltime,etime,z, ! s,l,e times, vert coord PRINTCAM.161
& ihdr(13),lrec,ihdr(16), ! lbtim,lblrec,lcode PRINTCAM.162
& ihdr(17),ihdr(18),ihdr(19), ! lbhem,lbrow,lbnpt PRINTCAM.163
& ihdr(23),ihdr(24),ihdr(25), ! lbfc,lbcfc,lbproc PRINTCAM.164
& ihdr(26),ihdr(27), ! lbvc,lbrvc PRINTCAM.165
& ihdr(33), ! lblev PRINTCAM.166
& ihdr(38),ihdr(42),ihdr(43), ! lbsrce,stash, pseudolevel PRINTCAM.167
& rhdr(46),rhdr(47), ! brsvd(1-2) (bulev,bhlev) PRINTCAM.168
& rhdr(50),rhdr(51), ! bdatum,bacc PRINTCAM.169
& rhdr(52),rhdr(53),rhdr(54),rhdr(55), ! blev,brlev,bhlev,bhrlev PRINTCAM.170
& rhdr(56),rhdr(57),rhdr(58), ! bplat,bplon bgor PRINTCAM.171
& rhdr(59),rhdr(60),rhdr(61),rhdr(62), ! bzy,bdy,bzx,bdx PRINTCAM.172
& rhdr(64) ! bmks PRINTCAM.173
PRINTCAM.174
1000 format(i10,1(":",i10),4(":",e20.13),15(":",i10),16(":",e13.6)) PRINTCAM.175
PRINTCAM.176
RETURN PRINTCAM.177
END PRINTCAM.178
PRINTCAM.179
integer function julday(year,month,day,err,cmessage) 2PRINTCAM.180
implicit none PRINTCAM.181
CLL PRINTCAM.182
CLL Purpose: computes julian day for a given year, month and day PRINTCAM.183
CLL Uses same algorithm as that shown In Numerical Recipes for Fortran PRINTCAM.184
PRINTCAM.185
CLL ============================================================ PRINTCAM.186
CLL Input arguments PRINTCAM.187
CLL PRINTCAM.188
integer year ! year PRINTCAM.189
integer month ! month PRINTCAM.190
integer day ! day of month PRINTCAM.191
integer err ! error code PRINTCAM.192
character*40 cmessage ! error message PRINTCAM.193
CLL ============================================================ PRINTCAM.194
CLL Local values PRINTCAM.195
CLL ============================================================ PRINTCAM.196
integer lyear ! local year PRINTCAM.197
integer ja ! scratch variable PRINTCAM.198
integer jyear,jmonth ! julain year and month PRINTCAM.199
integer igreg ! what day was the gregorian calendar ad PRINTCAM.200
parameter (igreg=15+31*(10+12*1582)) ! 15/10/1592 PRINTCAM.201
if (year.eq.0) then PRINTCAM.202
cmessage='There is no year 0' PRINTCAM.203
err=1 PRINTCAM.204
return PRINTCAM.205
endif PRINTCAM.206
if (year.lt.0) then PRINTCAM.207
lyear=year+1 PRINTCAM.208
else PRINTCAM.209
lyear=year PRINTCAM.210
endif PRINTCAM.211
if (month.gt.2) then PRINTCAM.212
jyear=lyear PRINTCAM.213
jmonth=month+1 PRINTCAM.214
else PRINTCAM.215
jyear=year-1 PRINTCAM.216
jmonth=month+13 PRINTCAM.217
endif PRINTCAM.218
julday=int(365.25*jyear)+int(30.6001*jmonth)+day+172995 PRINTCAM.219
if (day+31*(month+12*lyear).ge.igreg) then ! use gregorian calenda PRINTCAM.220
ja=int(0.01*jyear) PRINTCAM.221
julday=julday+2-ja+int(0.25*ja) PRINTCAM.222
endif PRINTCAM.223
return PRINTCAM.224
end PRINTCAM.225
*ENDIF PRINTCAM.226