*IF DEF,SCMA S_PRNSUB.2
C *****************************COPYRIGHT****************************** S_PRNSUB.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. S_PRNSUB.4
C S_PRNSUB.5
C Use, duplication or disclosure of this code is subject to the S_PRNSUB.6
C restrictions as set forth in the contract. S_PRNSUB.7
C S_PRNSUB.8
C Meteorological Office S_PRNSUB.9
C London Road S_PRNSUB.10
C BRACKNELL S_PRNSUB.11
C Berkshire UK S_PRNSUB.12
C RG12 2SZ S_PRNSUB.13
C S_PRNSUB.14
C If no contract has been raised with this copy of the code, the use, S_PRNSUB.15
C duplication or disclosure of it is strictly prohibited. Permission S_PRNSUB.16
C to do so must first be obtained in writing from the Head of Numerical S_PRNSUB.17
C Modelling at the above address. S_PRNSUB.18
C ******************************COPYRIGHT****************************** S_PRNSUB.19
C S_PRNSUB.20
C Subroutine PRINTSUB S_PRNSUB.21
C S_PRNSUB.22
C Single Column Unified Model routine to write out T and Q, and S_PRNSUB.23
C increments DT and DQ due to statistical forcing. S_PRNSUB.24
C Will print out any number of columns S_PRNSUB.25
C Jennifer Lean 20/10/90 S_PRNSUB.26
C S_PRNSUB.27
C Modification History: S_PRNSUB.28
C Version Date S_PRNSUB.29
C 4.5 07/98 SCM integrated as a standard UM configuration S_PRNSUB.30
C Introduce multicolumn SCM S_PRNSUB.31
C JC Thil. S_PRNSUB.32
C S_PRNSUB.33
C===================================================================== S_PRNSUB.34
C S_PRNSUB.35
Subroutine PRINTSUB( 2S_PRNSUB.36
C ! IN S_PRNSUB.37
& points, nlevs, nwet, S_PRNSUB.38
C ! S_PRNSUB.39
& title, istep, iday, t, q, dt, dq) S_PRNSUB.40
C S_PRNSUB.41
Implicit none S_PRNSUB.42
C S_PRNSUB.43
C--------------------------------------------------------------------- S_PRNSUB.44
C Arguments S_PRNSUB.45
C--------------------------------------------------------------------- S_PRNSUB.46
C S_PRNSUB.47
Integer S_PRNSUB.48
& points ! IN no of model columns. S_PRNSUB.49
& ,nlevs ! IN no of levels. S_PRNSUB.50
& ,nwet ! IN no of model levels in which Q is S_PRNSUB.51
! set S_PRNSUB.52
S_PRNSUB.53
Character*60 S_PRNSUB.54
& title ! Heading S_PRNSUB.55
Integer S_PRNSUB.56
& iday ! Day number S_PRNSUB.57
& ,istep ! Timestep S_PRNSUB.58
Real S_PRNSUB.59
& q(points,nlevs) ! Specific humidity (Kg Kg^-1) S_PRNSUB.60
& ,t(points,nlevs) ! Temperature (K) S_PRNSUB.61
& ,dt(points,nlevs) ! Temperature increment(K) S_PRNSUB.62
& ,dq(points,nlevs) ! Specific humidity increment S_PRNSUB.63
! (Kg Kg^-1) S_PRNSUB.64
C S_PRNSUB.65
C--------------------------------------------------------------------- S_PRNSUB.66
C Local variables S_PRNSUB.67
C--------------------------------------------------------------------- S_PRNSUB.68
C S_PRNSUB.69
Character*28 S_PRNSUB.70
& cfmt ! Format statement for each row S_PRNSUB.71
! of variables Q T DT DQ S_PRNSUB.72
Character*33 S_PRNSUB.73
& ctfmt ! Format statement for title S_PRNSUB.74
! of each row S_PRNSUB.75
Integer S_PRNSUB.76
& i ! Write statement loop counter S_PRNSUB.77
& ,l ! Loop counter S_PRNSUB.78
& ,element ! Array element no. S_PRNSUB.79
& ,lastrow ! No. of elements in last row S_PRNSUB.80
& ,nlevsrows, nlevscount ! No. of rows and Do Loop counter S_PRNSUB.81
& ,nwetrows, nwetcount ! S_PRNSUB.82
C S_PRNSUB.83
C Set format statements S_PRNSUB.84
C S_PRNSUB.85
cfmt = '('' '', (1pe10.3,1x))' S_PRNSUB.86
ctfmt = '(''0 '', (3x,''Level'',i2,1x))' S_PRNSUB.87
C S_PRNSUB.88
C Loop over sites : S_PRNSUB.89
C S_PRNSUB.90
Do l = 1, points S_PRNSUB.91
C S_PRNSUB.92
C Heading S_PRNSUB.93
C S_PRNSUB.94
Write (11,200) iday, istep, title S_PRNSUB.95
C S_PRNSUB.96
C Write out variables T and DT for NLEVS, maximum of 10 S_PRNSUB.97
C variables per row S_PRNSUB.98
C S_PRNSUB.99
Write (11,201) nlevs S_PRNSUB.100
C S_PRNSUB.101
C Calculate no. of rows and no. of elements in last row S_PRNSUB.102
C S_PRNSUB.103
If (mod(nlevs,10) .eq. 0) then S_PRNSUB.104
nlevsrows = int(nlevs/10) S_PRNSUB.105
lastrow = 10 S_PRNSUB.106
else S_PRNSUB.107
nlevsrows = int(nlevs/10) + 1 S_PRNSUB.108
lastrow = mod(nlevs,10) S_PRNSUB.109
endif S_PRNSUB.110
Do nlevscount = 1, nlevsrows S_PRNSUB.111
element = 10*(nlevscount-1) S_PRNSUB.112
If (nlevscount .lt. nlevsrows) then S_PRNSUB.113
C S_PRNSUB.114
C Write out all complete rows ie of 10 variables per row S_PRNSUB.115
C S_PRNSUB.116
Write(11,202) (element+i, i = 1, 10) S_PRNSUB.117
Write(11,203) (t(l,element+i), i = 1,10), S_PRNSUB.118
& (dt(l,element+i), i = 1, 10) S_PRNSUB.119
else S_PRNSUB.120
C S_PRNSUB.121
C Write out last row. Use an internal format statement by S_PRNSUB.122
C creating a character string. This will enable a variable S_PRNSUB.123
C format to be created eg NF10.6 where N is the no. of S_PRNSUB.124
C elements in the last row which can be written into the S_PRNSUB.125
C format statement via an internal write statement. S_PRNSUB.126
C S_PRNSUB.127
Write (ctfmt(13:14),'(i2)') lastrow S_PRNSUB.128
Write (11,ctfmt) (element+i,i=1,lastrow) S_PRNSUB.129
Write (cfmt(14:15),'(i2)') lastrow S_PRNSUB.130
Write (cfmt(4:7),'(''T K '')') S_PRNSUB.131
Write (11,cfmt) (t(l,i+element),i=1,lastrow) S_PRNSUB.132
Write (cfmt(4:7),'(''dT K'')') S_PRNSUB.133
Write (11,cfmt) (dt(l,i+element),i=1,lastrow) S_PRNSUB.134
endif S_PRNSUB.135
enddo S_PRNSUB.136
c S_PRNSUB.137
C Write out variables Q and DQ for NWET, maximum of 10 S_PRNSUB.138
C variables per row S_PRNSUB.139
C S_PRNSUB.140
Write (11,204) nwet S_PRNSUB.141
C S_PRNSUB.142
C Calculate no. of rows and no. of elements in last row S_PRNSUB.143
C S_PRNSUB.144
If ( mod(nwet,10) .eq. 0) then S_PRNSUB.145
nwetrows = int(nwet/10) S_PRNSUB.146
lastrow = 10 S_PRNSUB.147
else S_PRNSUB.148
nwetrows = int(nwet/10) + 1 S_PRNSUB.149
lastrow = mod(nwet,10) S_PRNSUB.150
endif S_PRNSUB.151
Do nwetcount = 1, nwetrows S_PRNSUB.152
element = 10*(nwetcount-1) S_PRNSUB.153
If (nwetcount .lt. nwetrows) then S_PRNSUB.154
C S_PRNSUB.155
C Write out all complete rows ie of 10 variables per row S_PRNSUB.156
C S_PRNSUB.157
Write (11,202) (element+i, i = 1, 10) S_PRNSUB.158
Write (11,205) (q(l,element+i),i = 1, 10), S_PRNSUB.159
& (dq(l,element+i), i = 1, 10) S_PRNSUB.160
else S_PRNSUB.161
C S_PRNSUB.162
C Write out last row. Use an internal format statement by S_PRNSUB.163
C creating a character string. This will enable a variable S_PRNSUB.164
C format to be created eg NF10.6 where N is the no. of S_PRNSUB.165
C elements in the last row which can be written into the S_PRNSUB.166
C format statement via an internal write statement. S_PRNSUB.167
C S_PRNSUB.168
Write (ctfmt(13:14),'(i2)') lastrow S_PRNSUB.169
Write (11,ctfmt) (element+i,i=1,lastrow) S_PRNSUB.170
Write (cfmt(4:10),'(''Q Kg/Kg'')') S_PRNSUB.171
Write (11,cfmt) (q(l,i+element),i=1,lastrow) S_PRNSUB.172
Write (cfmt(4:11),'(''dQ Kg/Kg'')') S_PRNSUB.173
Write (11,cfmt) (dq(l,i+element),i=1,lastrow) S_PRNSUB.174
endif S_PRNSUB.175
enddo S_PRNSUB.176
enddo ! l S_PRNSUB.177
C S_PRNSUB.178
200 Format('0Day relative to winter solstice',i5,'; timestep ',i5/ S_PRNSUB.179
& A60) S_PRNSUB.180
201 Format('0 Number of atmospheric levels = ',i3) S_PRNSUB.181
202 Format('0 level',i2,9(4x,'level',i2)) S_PRNSUB.182
203 Format(' t k ',10(1pe10.3,1x)/,' dT K ',10(1pe10.3,1x)/) S_PRNSUB.183
204 Format('0 Number of moist atmospheric levels = ',i3) S_PRNSUB.184
205 Format(' Q Kg/Kg ',10(1pe10.3,1x)/,' dQ Kg/Kg',10(1pe10.3,1x)/) S_PRNSUB.185
Return S_PRNSUB.186
End ! Subroutine PRINTSUB S_PRNSUB.187
*ENDIF S_PRNSUB.188
S_PRNSUB.189