subroutine writediagsoil(ngrid,name,title,units,dimpx,px) ! Write variable 'name' to NetCDF file 'diagsoil.nc'. ! The variable may be 3D (lon,lat,depth) subterranean field, ! a 2D (lon,lat) surface field, or a simple scalar (0D variable). ! ! Calls to 'writediagsoil' can originate from anywhere in the program; ! An initialisation of variable 'name' is done if it is the first time ! that this routine is called with given 'name'; otherwise data is appended ! (yielding the sought time series of the variable) use comsoil_h implicit none #include"dimensions.h" #include"dimphys.h" #include"paramet.h" #include"control.h" #include"netcdf.inc" ! Arguments: integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid ! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm character(len=*),intent(in) :: name ! 'name' of the variable character(len=*),intent(in) :: title ! 'long_name' attribute of the variable character(len=*),intent(in) :: units ! 'units' attribute of the variable integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0) real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable ! Note: nsoilmx is a common parameter set in 'dimphys.h' ! Local variables: real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data ! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h real,dimension(iip1,jjp1) :: data2 ! to store 2D data real :: data0 ! to store 0D data integer :: i,j,l ! for loops integer :: ig0 real,save :: date ! time counter (in elapsed days) integer,save :: isample ! sample rate at which data is to be written to output integer,save :: ntime=0 ! counter to internally store time steps character(len=20),save :: firstname="1234567890" integer,save :: zitau=0 character(len=30) :: filename="diagsoil.nc" ! NetCDF stuff: integer :: nid ! NetCDF output file ID integer :: varid ! NetCDF ID of a variable integer :: ierr ! NetCDF routines return code integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable integer,dimension(4) :: edges,corners ! 1. Initialization step if (firstname.eq."1234567890") then ! Store 'name' as 'firstname' firstname=name ! From now on, if 'name'.eq.'firstname', then it is a new time cycle ! just to be sure, check that firstnom is large enough to hold nom if (len_trim(firstname).lt.len_trim(name)) then write(*,*) "writediagsoil: Error !!!" write(*,*) " firstname string not long enough!!" write(*,*) " increase its size to at least ",len_trim(name) stop endif ! Set output sample rate isample=int(ecritphy) ! same as for diagfi outputs ! Note ecritphy is known from control.h ! Create output NetCDF file ierr=NF_CREATE(filename,NF_CLOBBER,nid) if (ierr.ne.NF_NOERR) then write(*,*)'writediagsoil: Error, failed creating file '//trim(filename) stop endif ! Define dimensions and axis attributes call iniwritesoil(nid,ngrid) ! set zitau to -1 to be compatible with zitau incrementation step below zitau=-1 else ! If not an initialization call, simply open the NetCDF file ierr=NF_OPEN(filename,NF_WRITE,nid) endif ! of if (firstname.eq."1234567890") ! 2. Increment local time counter, if necessary if (name.eq.firstname) then ! if we run across 'firstname', then it is a new time step zitau=zitau+iphysiq ! Note iphysiq is known from control.h endif ! 3. Write data, if the time index matches the sample rate if (mod(zitau+1,isample).eq.0) then ! 3.1 If first call at this date, update 'time' variable if (name.eq.firstname) then ntime=ntime+1 date=float(zitau+1)/float(day_step) ! Note: day_step is known from control.h ! Get NetCDF ID for "time" ierr=NF_INQ_VARID(nid,"time",varid) ! Add the current value of date to the "time" array #ifdef NC_DOUBLE ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date) #else ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date) #endif if (ierr.ne.NF_NOERR) then write(*,*)"writediagsoil: Failed writing date to time variable" stop endif endif ! of if (name.eq.firstname) ! 3.2 Write the variable to the NetCDF file if (dimpx.eq.3) then ! Case of a 3D variable ! A. Recast data along 'dynamics' grid do l=1,nsoilmx ! handle the poles do i=1,iip1 data3(i,1,l)=px(1,l) data3(i,jjp1,l)=px(ngrid,l) enddo ! rest of the grid do j=2,jjm ig0=1+(j-2)*iim do i=1,iim data3(i,j,l)=px(ig0+i,l) enddo data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude enddo enddo ! B. Write (append) the variable to the NetCDF file ! B.1. Get the ID of the variable ierr=NF_INQ_VARID(nid,name,varid) if (ierr.ne.NF_NOERR) then ! If we failed geting the variable's ID, we assume it is because ! the variable doesn't exist yet and must be created. ! Start by obtaining corresponding dimensions IDs ierr=NF_INQ_DIMID(nid,"longitude",id(1)) ierr=NF_INQ_DIMID(nid,"latitude",id(2)) ierr=NF_INQ_DIMID(nid,"depth",id(3)) ierr=NF_INQ_DIMID(nid,"time",id(4)) ! Tell the world about it write(*,*) "=====================" write(*,*) "writediagsoil: creating variable "//trim(name) call def_var(nid,name,title,units,4,id,varid,ierr) endif ! of if (ierr.ne.NF_NOERR) ! B.2. Prepare things to be able to write/append the variable corners(1)=1 corners(2)=1 corners(3)=1 corners(4)=ntime edges(1)=iip1 edges(2)=jjp1 edges(3)=nsoilmx edges(4)=1 ! B.3. Write the slab of data #ifdef NC_DOUBLE ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3) #else ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3) #endif if (ierr.ne.NF_NOERR) then write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& " to file "//trim(filename)//" at time",date endif elseif (dimpx.eq.2) then ! Case of a 2D variable ! A. Recast data along 'dynamics' grid ! handle the poles do i=1,iip1 data2(i,1)=px(1,1) data2(i,jjp1)=px(ngrid,1) enddo ! rest of the grid do j=2,jjm ig0=1+(j-2)*iim do i=1,iim data2(i,j)=px(ig0+i,1) enddo data2(iip1,j)=data2(1,j) ! extra (modulo) longitude enddo ! B. Write (append) the variable to the NetCDF file ! B.1. Get the ID of the variable ierr=NF_INQ_VARID(nid,name,varid) if (ierr.ne.NF_NOERR) then ! If we failed geting the variable's ID, we assume it is because ! the variable doesn't exist yet and must be created. ! Start by obtaining corresponding dimensions IDs ierr=NF_INQ_DIMID(nid,"longitude",id(1)) ierr=NF_INQ_DIMID(nid,"latitude",id(2)) ierr=NF_INQ_DIMID(nid,"time",id(3)) ! Tell the world about it write(*,*) "=====================" write(*,*) "writediagsoil: creating variable "//trim(name) call def_var(nid,name,title,units,3,id,varid,ierr) endif ! of if (ierr.ne.NF_NOERR) ! B.2. Prepare things to be able to write/append the variable corners(1)=1 corners(2)=1 corners(3)=ntime edges(1)=iip1 edges(2)=jjp1 edges(3)=1 ! B.3. Write the slab of data #ifdef NC_DOUBLE ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2) #else ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2) #endif if (ierr.ne.NF_NOERR) then write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& " to file "//trim(filename)//" at time",date endif elseif (dimpx.eq.0) then ! Case of a 0D variable ! A. Copy data value data0=px(1,1) ! B. Write (append) the variable to the NetCDF file ! B.1. Get the ID of the variable ierr=NF_INQ_VARID(nid,name,varid) if (ierr.ne.NF_NOERR) then ! If we failed geting the variable's ID, we assume it is because ! the variable doesn't exist yet and must be created. ! Start by obtaining corresponding dimensions IDs ierr=NF_INQ_DIMID(nid,"time",id(1)) ! Tell the world about it write(*,*) "=====================" write(*,*) "writediagsoil: creating variable "//trim(name) call def_var(nid,name,title,units,1,id,varid,ierr) endif ! of if (ierr.ne.NF_NOERR) ! B.2. Prepare things to be able to write/append the variable corners(1)=ntime edges(1)=1 ! B.3. Write the data #ifdef NC_DOUBLE ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0) #else ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0) #endif if (ierr.ne.NF_NOERR) then write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//& " to file "//trim(filename)//" at time",date endif endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ... endif ! of if (mod(zitau+1,isample).eq.0) ! 4. Close the NetCDF file ierr=NF_CLOSE(nid) end subroutine writediagsoil