[135] | 1 | subroutine writediagsoil(ngrid,name,title,units,dimpx,px) |
---|
| 2 | |
---|
| 3 | ! Write variable 'name' to NetCDF file 'diagsoil.nc'. |
---|
| 4 | ! The variable may be 3D (lon,lat,depth) subterranean field, |
---|
| 5 | ! a 2D (lon,lat) surface field, or a simple scalar (0D variable). |
---|
| 6 | ! |
---|
| 7 | ! Calls to 'writediagsoil' can originate from anywhere in the program; |
---|
| 8 | ! An initialisation of variable 'name' is done if it is the first time |
---|
| 9 | ! that this routine is called with given 'name'; otherwise data is appended |
---|
| 10 | ! (yielding the sought time series of the variable) |
---|
| 11 | |
---|
| 12 | implicit none |
---|
| 13 | |
---|
| 14 | #include"dimensions.h" |
---|
| 15 | #include"dimphys.h" |
---|
| 16 | #include"paramet.h" |
---|
| 17 | #include"control.h" |
---|
| 18 | #include"comsoil.h" |
---|
| 19 | #include"netcdf.inc" |
---|
| 20 | |
---|
| 21 | ! Arguments: |
---|
| 22 | integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid |
---|
| 23 | ! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm |
---|
| 24 | character(len=*),intent(in) :: name ! 'name' of the variable |
---|
| 25 | character(len=*),intent(in) :: title ! 'long_name' attribute of the variable |
---|
| 26 | character(len=*),intent(in) :: units ! 'units' attribute of the variable |
---|
| 27 | integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0) |
---|
| 28 | real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable |
---|
| 29 | ! Note: nsoilmx is a common parameter set in 'dimphys.h' |
---|
| 30 | |
---|
| 31 | ! Local variables: |
---|
| 32 | real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data |
---|
| 33 | ! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h |
---|
| 34 | real,dimension(iip1,jjp1) :: data2 ! to store 2D data |
---|
| 35 | real :: data0 ! to store 0D data |
---|
| 36 | integer :: i,j,l ! for loops |
---|
| 37 | integer :: ig0 |
---|
| 38 | |
---|
| 39 | real,save :: date ! time counter (in elapsed days) |
---|
| 40 | integer,save :: isample ! sample rate at which data is to be written to output |
---|
| 41 | integer,save :: ntime=0 ! counter to internally store time steps |
---|
| 42 | character(len=20),save :: firstname="1234567890" |
---|
| 43 | integer,save :: zitau=0 |
---|
| 44 | |
---|
| 45 | character(len=30) :: filename="diagsoil.nc" |
---|
| 46 | |
---|
| 47 | ! NetCDF stuff: |
---|
| 48 | integer :: nid ! NetCDF output file ID |
---|
| 49 | integer :: varid ! NetCDF ID of a variable |
---|
| 50 | integer :: ierr ! NetCDF routines return code |
---|
| 51 | integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable |
---|
| 52 | integer,dimension(4) :: edges,corners |
---|
| 53 | |
---|
| 54 | ! 1. Initialization step |
---|
| 55 | if (firstname.eq."1234567890") then |
---|
| 56 | ! Store 'name' as 'firstname' |
---|
| 57 | firstname=name |
---|
| 58 | ! From now on, if 'name'.eq.'firstname', then it is a new time cycle |
---|
| 59 | |
---|
| 60 | ! just to be sure, check that firstnom is large enough to hold nom |
---|
| 61 | if (len_trim(firstname).lt.len_trim(name)) then |
---|
| 62 | write(*,*) "writediagsoil: Error !!!" |
---|
| 63 | write(*,*) " firstname string not long enough!!" |
---|
| 64 | write(*,*) " increase its size to at least ",len_trim(name) |
---|
| 65 | stop |
---|
| 66 | endif |
---|
| 67 | |
---|
| 68 | ! Set output sample rate |
---|
| 69 | isample=int(ecritphy) ! same as for diagfi outputs |
---|
| 70 | ! Note ecritphy is known from control.h |
---|
| 71 | |
---|
| 72 | ! Create output NetCDF file |
---|
| 73 | ierr=NF_CREATE(filename,NF_CLOBBER,nid) |
---|
| 74 | if (ierr.ne.NF_NOERR) then |
---|
| 75 | write(*,*)'writediagsoil: Error, failed creating file '//trim(filename) |
---|
| 76 | stop |
---|
| 77 | endif |
---|
| 78 | |
---|
| 79 | ! Define dimensions and axis attributes |
---|
| 80 | call iniwritesoil(nid) |
---|
| 81 | |
---|
| 82 | ! set zitau to -1 to be compatible with zitau incrementation step below |
---|
| 83 | zitau=-1 |
---|
| 84 | |
---|
| 85 | else |
---|
| 86 | ! If not an initialization call, simply open the NetCDF file |
---|
| 87 | ierr=NF_OPEN(filename,NF_WRITE,nid) |
---|
| 88 | endif ! of if (firstname.eq."1234567890") |
---|
| 89 | |
---|
| 90 | ! 2. Increment local time counter, if necessary |
---|
| 91 | if (name.eq.firstname) then |
---|
| 92 | ! if we run across 'firstname', then it is a new time step |
---|
| 93 | zitau=zitau+iphysiq |
---|
| 94 | ! Note iphysiq is known from control.h |
---|
| 95 | endif |
---|
| 96 | |
---|
| 97 | ! 3. Write data, if the time index matches the sample rate |
---|
| 98 | if (mod(zitau+1,isample).eq.0) then |
---|
| 99 | |
---|
| 100 | ! 3.1 If first call at this date, update 'time' variable |
---|
| 101 | if (name.eq.firstname) then |
---|
| 102 | ntime=ntime+1 |
---|
| 103 | date=float(zitau+1)/float(day_step) |
---|
| 104 | ! Note: day_step is known from control.h |
---|
| 105 | |
---|
| 106 | ! Get NetCDF ID for "time" |
---|
| 107 | ierr=NF_INQ_VARID(nid,"time",varid) |
---|
| 108 | ! Add the current value of date to the "time" array |
---|
| 109 | #ifdef NC_DOUBLE |
---|
| 110 | ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date) |
---|
| 111 | #else |
---|
| 112 | ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date) |
---|
| 113 | #endif |
---|
| 114 | if (ierr.ne.NF_NOERR) then |
---|
| 115 | write(*,*)"writediagsoil: Failed writing date to time variable" |
---|
| 116 | stop |
---|
| 117 | endif |
---|
| 118 | endif ! of if (name.eq.firstname) |
---|
| 119 | |
---|
| 120 | ! 3.2 Write the variable to the NetCDF file |
---|
| 121 | if (dimpx.eq.3) then ! Case of a 3D variable |
---|
| 122 | ! A. Recast data along 'dynamics' grid |
---|
| 123 | do l=1,nsoilmx |
---|
| 124 | ! handle the poles |
---|
| 125 | do i=1,iip1 |
---|
| 126 | data3(i,1,l)=px(1,l) |
---|
| 127 | data3(i,jjp1,l)=px(ngrid,l) |
---|
| 128 | enddo |
---|
| 129 | ! rest of the grid |
---|
| 130 | do j=2,jjm |
---|
| 131 | ig0=1+(j-2)*iim |
---|
| 132 | do i=1,iim |
---|
| 133 | data3(i,j,l)=px(ig0+i,l) |
---|
| 134 | enddo |
---|
| 135 | data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude |
---|
| 136 | enddo |
---|
| 137 | enddo |
---|
| 138 | |
---|
| 139 | ! B. Write (append) the variable to the NetCDF file |
---|
| 140 | ! B.1. Get the ID of the variable |
---|
| 141 | ierr=NF_INQ_VARID(nid,name,varid) |
---|
| 142 | if (ierr.ne.NF_NOERR) then |
---|
| 143 | ! If we failed geting the variable's ID, we assume it is because |
---|
| 144 | ! the variable doesn't exist yet and must be created. |
---|
| 145 | ! Start by obtaining corresponding dimensions IDs |
---|
| 146 | ierr=NF_INQ_DIMID(nid,"longitude",id(1)) |
---|
| 147 | ierr=NF_INQ_DIMID(nid,"latitude",id(2)) |
---|
| 148 | ierr=NF_INQ_DIMID(nid,"depth",id(3)) |
---|
| 149 | ierr=NF_INQ_DIMID(nid,"time",id(4)) |
---|
| 150 | ! Tell the world about it |
---|
| 151 | write(*,*) "=====================" |
---|
| 152 | write(*,*) "writediagsoil: creating variable "//trim(name) |
---|
| 153 | call def_var(nid,name,title,units,4,id,varid,ierr) |
---|
| 154 | endif ! of if (ierr.ne.NF_NOERR) |
---|
| 155 | |
---|
| 156 | ! B.2. Prepare things to be able to write/append the variable |
---|
| 157 | corners(1)=1 |
---|
| 158 | corners(2)=1 |
---|
| 159 | corners(3)=1 |
---|
| 160 | corners(4)=ntime |
---|
| 161 | |
---|
| 162 | edges(1)=iip1 |
---|
| 163 | edges(2)=jjp1 |
---|
| 164 | edges(3)=nsoilmx |
---|
| 165 | edges(4)=1 |
---|
| 166 | |
---|
| 167 | ! B.3. Write the slab of data |
---|
| 168 | #ifdef NC_DOUBLE |
---|
| 169 | ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3) |
---|
| 170 | #else |
---|
| 171 | ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3) |
---|
| 172 | #endif |
---|
| 173 | if (ierr.ne.NF_NOERR) then |
---|
| 174 | write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& |
---|
| 175 | " to file "//trim(filename)//" at time",date |
---|
| 176 | endif |
---|
| 177 | |
---|
| 178 | elseif (dimpx.eq.2) then ! Case of a 2D variable |
---|
| 179 | ! A. Recast data along 'dynamics' grid |
---|
| 180 | ! handle the poles |
---|
| 181 | do i=1,iip1 |
---|
| 182 | data2(i,1)=px(1,1) |
---|
| 183 | data2(i,jjp1)=px(ngrid,1) |
---|
| 184 | enddo |
---|
| 185 | ! rest of the grid |
---|
| 186 | do j=2,jjm |
---|
| 187 | ig0=1+(j-2)*iim |
---|
| 188 | do i=1,iim |
---|
| 189 | data2(i,j)=px(ig0+i,1) |
---|
| 190 | enddo |
---|
| 191 | data2(iip1,j)=data2(1,j) ! extra (modulo) longitude |
---|
| 192 | enddo |
---|
| 193 | |
---|
| 194 | ! B. Write (append) the variable to the NetCDF file |
---|
| 195 | ! B.1. Get the ID of the variable |
---|
| 196 | ierr=NF_INQ_VARID(nid,name,varid) |
---|
| 197 | if (ierr.ne.NF_NOERR) then |
---|
| 198 | ! If we failed geting the variable's ID, we assume it is because |
---|
| 199 | ! the variable doesn't exist yet and must be created. |
---|
| 200 | ! Start by obtaining corresponding dimensions IDs |
---|
| 201 | ierr=NF_INQ_DIMID(nid,"longitude",id(1)) |
---|
| 202 | ierr=NF_INQ_DIMID(nid,"latitude",id(2)) |
---|
| 203 | ierr=NF_INQ_DIMID(nid,"time",id(3)) |
---|
| 204 | ! Tell the world about it |
---|
| 205 | write(*,*) "=====================" |
---|
| 206 | write(*,*) "writediagsoil: creating variable "//trim(name) |
---|
| 207 | call def_var(nid,name,title,units,3,id,varid,ierr) |
---|
| 208 | endif ! of if (ierr.ne.NF_NOERR) |
---|
| 209 | |
---|
| 210 | ! B.2. Prepare things to be able to write/append the variable |
---|
| 211 | corners(1)=1 |
---|
| 212 | corners(2)=1 |
---|
| 213 | corners(3)=ntime |
---|
| 214 | |
---|
| 215 | edges(1)=iip1 |
---|
| 216 | edges(2)=jjp1 |
---|
| 217 | edges(3)=1 |
---|
| 218 | |
---|
| 219 | ! B.3. Write the slab of data |
---|
| 220 | #ifdef NC_DOUBLE |
---|
| 221 | ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2) |
---|
| 222 | #else |
---|
| 223 | ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2) |
---|
| 224 | #endif |
---|
| 225 | if (ierr.ne.NF_NOERR) then |
---|
| 226 | write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& |
---|
| 227 | " to file "//trim(filename)//" at time",date |
---|
| 228 | endif |
---|
| 229 | |
---|
| 230 | elseif (dimpx.eq.0) then ! Case of a 0D variable |
---|
| 231 | ! A. Copy data value |
---|
| 232 | data0=px(1,1) |
---|
| 233 | |
---|
| 234 | ! B. Write (append) the variable to the NetCDF file |
---|
| 235 | ! B.1. Get the ID of the variable |
---|
| 236 | ierr=NF_INQ_VARID(nid,name,varid) |
---|
| 237 | if (ierr.ne.NF_NOERR) then |
---|
| 238 | ! If we failed geting the variable's ID, we assume it is because |
---|
| 239 | ! the variable doesn't exist yet and must be created. |
---|
| 240 | ! Start by obtaining corresponding dimensions IDs |
---|
| 241 | ierr=NF_INQ_DIMID(nid,"time",id(1)) |
---|
| 242 | ! Tell the world about it |
---|
| 243 | write(*,*) "=====================" |
---|
| 244 | write(*,*) "writediagsoil: creating variable "//trim(name) |
---|
| 245 | call def_var(nid,name,title,units,1,id,varid,ierr) |
---|
| 246 | endif ! of if (ierr.ne.NF_NOERR) |
---|
| 247 | |
---|
| 248 | ! B.2. Prepare things to be able to write/append the variable |
---|
| 249 | corners(1)=ntime |
---|
| 250 | |
---|
| 251 | edges(1)=1 |
---|
| 252 | |
---|
| 253 | ! B.3. Write the data |
---|
| 254 | #ifdef NC_DOUBLE |
---|
| 255 | ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0) |
---|
| 256 | #else |
---|
| 257 | ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0) |
---|
| 258 | #endif |
---|
| 259 | if (ierr.ne.NF_NOERR) then |
---|
| 260 | write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& |
---|
| 261 | " to file "//trim(filename)//" at time",date |
---|
| 262 | endif |
---|
| 263 | |
---|
| 264 | endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ... |
---|
| 265 | endif ! of if (mod(zitau+1,isample).eq.0) |
---|
| 266 | |
---|
| 267 | ! 4. Close the NetCDF file |
---|
| 268 | ierr=NF_CLOSE(nid) |
---|
| 269 | |
---|
| 270 | end subroutine writediagsoil |
---|