[1980] | 1 | subroutine iotd_ecrit(nom,llm,titre,unite,px) |
---|
| 2 | |
---|
| 3 | |
---|
| 4 | !======================================================================= |
---|
| 5 | ! |
---|
| 6 | ! Auteur: F. Hourdin |
---|
| 7 | ! ------- |
---|
| 8 | ! |
---|
| 9 | ! Objet: |
---|
| 10 | ! ------ |
---|
| 11 | ! Light interface for netcdf outputs. can be used outside LMDZ |
---|
| 12 | ! |
---|
| 13 | !======================================================================= |
---|
| 14 | !----------------------------------------------------------------------- |
---|
| 15 | ! ---------- |
---|
| 16 | ! nom : nom de la variable a sortir (chaine de caracteres) |
---|
| 17 | ! llm : nombre de couches |
---|
| 18 | ! titre: titre de la variable (chaine de caracteres) |
---|
| 19 | ! unite : unite de la variable (chaine de caracteres) |
---|
| 20 | ! px : variable a sortir |
---|
| 21 | ! |
---|
| 22 | !================================================================= |
---|
| 23 | |
---|
[4368] | 24 | use netcdf, only: nf90_put_var |
---|
[1980] | 25 | implicit none |
---|
| 26 | |
---|
| 27 | ! Commons |
---|
| 28 | |
---|
| 29 | #include "netcdf.inc" |
---|
| 30 | #include "iotd.h" |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | ! Arguments on input: |
---|
| 34 | integer llm |
---|
| 35 | character (len=*) :: nom,titre,unite |
---|
| 36 | integer imjmax |
---|
| 37 | parameter (imjmax=100000) |
---|
| 38 | real px(imjmax*llm) |
---|
| 39 | |
---|
| 40 | ! Local variables: |
---|
| 41 | |
---|
| 42 | real*4 date |
---|
| 43 | real*4 zx(imjmax*llm) |
---|
| 44 | |
---|
| 45 | |
---|
| 46 | integer ierr,ndim,dim_cc(4) |
---|
| 47 | integer iq |
---|
| 48 | integer i,j,l |
---|
| 49 | |
---|
| 50 | integer zitau |
---|
| 51 | character firstnom*20 |
---|
| 52 | SAVE firstnom |
---|
| 53 | SAVE zitau |
---|
| 54 | SAVE date |
---|
| 55 | data firstnom /'1234567890'/ |
---|
| 56 | data zitau /0/ |
---|
| 57 | |
---|
| 58 | ! Ajouts |
---|
| 59 | integer, save :: ntime=0 |
---|
| 60 | integer :: idim,varid |
---|
| 61 | character (len =50):: fichnom |
---|
| 62 | integer, dimension(4) :: id |
---|
| 63 | integer, dimension(4) :: edges,corner |
---|
| 64 | |
---|
| 65 | |
---|
[4013] | 66 | |
---|
| 67 | if (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) return |
---|
[1980] | 68 | !*************************************************************** |
---|
| 69 | ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file |
---|
| 70 | ! ------------------------------------------------------------------------ |
---|
| 71 | ! (Au tout premier appel de la subroutine durant le run.) |
---|
| 72 | |
---|
| 73 | |
---|
| 74 | !-------------------------------------------------------- |
---|
| 75 | ! Write the variables to output file if it's time to do so |
---|
| 76 | !-------------------------------------------------------- |
---|
| 77 | |
---|
| 78 | |
---|
[4013] | 79 | ! Compute/write/extend 'time' coordinate (date given in days) |
---|
[1980] | 80 | ! (done every "first call" (at given time level) to writediagfi) |
---|
| 81 | ! Note: date is incremented as 1 step ahead of physics time |
---|
| 82 | !-------------------------------------------------------- |
---|
| 83 | |
---|
| 84 | zx(1:imax*jmax*llm)=px(1:imax*jmax*llm) |
---|
| 85 | if (firstnom =='1234567890') then |
---|
| 86 | firstnom=nom |
---|
| 87 | endif |
---|
| 88 | |
---|
[4013] | 89 | !print*,'nom ',nom,firstnom |
---|
[1980] | 90 | |
---|
| 91 | !! Quand on tombe sur la premiere variable on ajoute un pas de temps |
---|
| 92 | if (nom.eq.firstnom) then |
---|
| 93 | ! We have identified a "first call" (at given date) |
---|
| 94 | |
---|
| 95 | ntime=ntime+1 ! increment # of stored time steps |
---|
| 96 | |
---|
| 97 | !! print*,'ntime ',ntime |
---|
[4013] | 98 | date=iotd_t0+ntime*iotd_ts |
---|
| 99 | !print*,'iotd_ecrit ',iotd_ts,ntime, date |
---|
[1980] | 100 | ! date= float (zitau +1)/float (day_step) |
---|
| 101 | |
---|
| 102 | ! compute corresponding date (in days and fractions thereof) |
---|
[4013] | 103 | ! Get NetCDF ID of 'time' variable |
---|
[1980] | 104 | |
---|
| 105 | ierr=NF_SYNC(nid) |
---|
| 106 | |
---|
[4013] | 107 | ierr= NF_INQ_VARID(nid,"time",varid) |
---|
| 108 | ! Write (append) the new date to the 'time' array |
---|
[1980] | 109 | |
---|
| 110 | |
---|
[4368] | 111 | ierr= NF90_PUT_VAR(nid,varid,date,[ntime]) |
---|
[1980] | 112 | |
---|
| 113 | ! print*,'date ',date,ierr,nid |
---|
| 114 | ! print*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date |
---|
| 115 | |
---|
| 116 | if (ierr.ne.NF_NOERR) then |
---|
| 117 | write(*,*) "***** PUT_VAR matter in writediagfi_nc" |
---|
| 118 | write(*,*) "***** with time" |
---|
| 119 | write(*,*) 'ierr=', ierr |
---|
| 120 | endif |
---|
| 121 | |
---|
| 122 | ! write(6,*)'WRITEDIAGFI: date= ', date |
---|
| 123 | end if ! of if (nom.eq.firstnom) |
---|
| 124 | |
---|
| 125 | |
---|
| 126 | !Case of a 3D variable |
---|
| 127 | !--------------------- |
---|
| 128 | if (llm==lmax) then |
---|
| 129 | ndim=4 |
---|
| 130 | corner(1)=1 |
---|
| 131 | corner(2)=1 |
---|
| 132 | corner(3)=1 |
---|
| 133 | corner(4)=ntime |
---|
| 134 | edges(1)=imax |
---|
| 135 | edges(2)=jmax |
---|
| 136 | edges(3)=llm |
---|
| 137 | edges(4)=1 |
---|
| 138 | dim_cc=dim_coord |
---|
| 139 | |
---|
| 140 | |
---|
| 141 | !Case of a 2D variable |
---|
| 142 | !--------------------- |
---|
| 143 | |
---|
| 144 | else if (llm==1) then |
---|
| 145 | ndim=3 |
---|
| 146 | corner(1)=1 |
---|
| 147 | corner(2)=1 |
---|
| 148 | corner(3)=ntime |
---|
| 149 | corner(4)=1 |
---|
| 150 | edges(1)=imax |
---|
| 151 | edges(2)=jmax |
---|
| 152 | edges(3)=1 |
---|
| 153 | edges(4)=1 |
---|
| 154 | dim_cc(1:2)=dim_coord(1:2) |
---|
| 155 | dim_cc(3)=dim_coord(4) |
---|
| 156 | |
---|
| 157 | endif ! of if llm=1 ou llm |
---|
| 158 | |
---|
| 159 | ! AU premier pas de temps, on crée les variables |
---|
| 160 | !----------------------------------------------- |
---|
| 161 | |
---|
| 162 | if (ntime==1) then |
---|
| 163 | ierr = NF_REDEF (nid) |
---|
| 164 | ierr = NF_DEF_VAR(nid,nom,NF_FLOAT,ndim,dim_cc,varid) |
---|
[4013] | 165 | !print*,'DEF ',nom,nid,varid |
---|
[1980] | 166 | ierr = NF_ENDDEF(nid) |
---|
| 167 | else |
---|
| 168 | ierr= NF_INQ_VARID(nid,nom,varid) |
---|
[4013] | 169 | !print*,'INQ ',nom,nid,varid |
---|
[1980] | 170 | ! Commandes pour recuperer automatiquement les coordonnees |
---|
| 171 | ! ierr= NF_INQ_DIMID(nid,"longitude",id(1)) |
---|
| 172 | endif |
---|
| 173 | |
---|
| 174 | |
---|
[4368] | 175 | ierr= NF90_PUT_VAR(nid,varid,zx,corner,edges) |
---|
[1980] | 176 | |
---|
| 177 | if (ierr.ne.NF_NOERR) then |
---|
| 178 | write(*,*) "***** PUT_VAR problem in writediagfi" |
---|
| 179 | write(*,*) "***** with ",nom |
---|
| 180 | write(*,*) 'ierr=', ierr |
---|
| 181 | endif |
---|
| 182 | |
---|
| 183 | |
---|
| 184 | end |
---|