[5103] | 1 | SUBROUTINE iotd_ecrit(nom,llm,titre,unite,px) |
---|
[1980] | 2 | |
---|
| 3 | |
---|
| 4 | !======================================================================= |
---|
[5099] | 5 | |
---|
[1980] | 6 | ! Auteur: F. Hourdin |
---|
| 7 | ! ------- |
---|
[5099] | 8 | |
---|
[1980] | 9 | ! Objet: |
---|
| 10 | ! ------ |
---|
| 11 | ! Light interface for netcdf outputs. can be used outside LMDZ |
---|
[5099] | 12 | |
---|
[1980] | 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 |
---|
[5099] | 21 | |
---|
[1980] | 22 | !================================================================= |
---|
| 23 | |
---|
[5088] | 24 | USE netcdf, ONLY: nf90_put_var,nf90_inq_varid,nf90_enddef,nf90_redef,nf90_sync,nf90_noerr,& |
---|
| 25 | nf90_float,nf90_def_var |
---|
[5113] | 26 | IMPLICIT NONE |
---|
[1980] | 27 | |
---|
| 28 | ! Commons |
---|
| 29 | |
---|
[4593] | 30 | INCLUDE "iotd.h" |
---|
[1980] | 31 | |
---|
| 32 | |
---|
| 33 | ! Arguments on input: |
---|
[5117] | 34 | INTEGER llm |
---|
| 35 | CHARACTER (LEN=*) :: nom,titre,unite |
---|
| 36 | INTEGER imjmax |
---|
[1980] | 37 | parameter (imjmax=100000) |
---|
[5117] | 38 | REAL px(imjmax*llm) |
---|
[1980] | 39 | |
---|
| 40 | ! Local variables: |
---|
| 41 | |
---|
[5082] | 42 | real(kind=4) date |
---|
| 43 | real(kind=4) zx(imjmax*llm) |
---|
[1980] | 44 | |
---|
| 45 | |
---|
[5117] | 46 | INTEGER ierr,ndim,dim_cc(4) |
---|
| 47 | INTEGER iq |
---|
| 48 | INTEGER i,j,l |
---|
[1980] | 49 | |
---|
[5117] | 50 | INTEGER zitau |
---|
[1980] | 51 | character firstnom*20 |
---|
| 52 | SAVE firstnom |
---|
| 53 | SAVE zitau |
---|
| 54 | SAVE date |
---|
| 55 | data firstnom /'1234567890'/ |
---|
| 56 | data zitau /0/ |
---|
| 57 | |
---|
| 58 | ! Ajouts |
---|
[5117] | 59 | INTEGER, save :: ntime=0 |
---|
[5116] | 60 | INTEGER :: idim,varid |
---|
[5117] | 61 | CHARACTER (LEN =50):: fichnom |
---|
| 62 | INTEGER, DIMENSION(4) :: id |
---|
| 63 | INTEGER, DIMENSION(4) :: edges,corner |
---|
[1980] | 64 | |
---|
| 65 | |
---|
[3978] | 66 | |
---|
[5117] | 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 | ! ------------------------------------------------------------------------ |
---|
[5103] | 71 | ! (Au tout premier appel de la SUBROUTINE durant le run.) |
---|
[1980] | 72 | |
---|
| 73 | |
---|
| 74 | !-------------------------------------------------------- |
---|
| 75 | ! Write the variables to output file if it's time to do so |
---|
| 76 | !-------------------------------------------------------- |
---|
| 77 | |
---|
| 78 | |
---|
[3977] | 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) |
---|
[5117] | 85 | IF (firstnom =='1234567890') THEN |
---|
[1980] | 86 | firstnom=nom |
---|
| 87 | endif |
---|
| 88 | |
---|
[5103] | 89 | !PRINT*,'nom ',nom,firstnom |
---|
[1980] | 90 | |
---|
| 91 | !! Quand on tombe sur la premiere variable on ajoute un pas de temps |
---|
[5117] | 92 | IF (nom==firstnom) THEN |
---|
[1980] | 93 | ! We have identified a "first call" (at given date) |
---|
| 94 | |
---|
| 95 | ntime=ntime+1 ! increment # of stored time steps |
---|
| 96 | |
---|
[5103] | 97 | !! PRINT*,'ntime ',ntime |
---|
[3977] | 98 | date=iotd_t0+ntime*iotd_ts |
---|
[5103] | 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) |
---|
[3977] | 103 | ! Get NetCDF ID of 'time' variable |
---|
[1980] | 104 | |
---|
[5088] | 105 | ierr=nf90_sync(nid) |
---|
[1980] | 106 | |
---|
[5088] | 107 | ierr= nf90_inq_varid(nid,"time",varid) |
---|
[3977] | 108 | ! Write (append) the new date to the 'time' array |
---|
[1980] | 109 | |
---|
| 110 | |
---|
[5100] | 111 | ierr= nf90_put_var(nid,varid,date,[ntime]) |
---|
[1980] | 112 | |
---|
[5103] | 113 | ! PRINT*,'date ',date,ierr,nid |
---|
| 114 | ! PRINT*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date |
---|
[1980] | 115 | |
---|
[5117] | 116 | IF (ierr/=nf90_noerr) THEN |
---|
[5116] | 117 | WRITE(*,*) "***** PUT_VAR matter in writediagfi_nc" |
---|
| 118 | WRITE(*,*) "***** with time" |
---|
| 119 | WRITE(*,*) 'ierr=', ierr |
---|
[1980] | 120 | endif |
---|
| 121 | |
---|
[5116] | 122 | ! WRITE(6,*)'WRITEDIAGFI: date= ', date |
---|
[5117] | 123 | end if ! of if (nom.EQ.firstnom) |
---|
[1980] | 124 | |
---|
| 125 | |
---|
| 126 | !Case of a 3D variable |
---|
| 127 | !--------------------- |
---|
[5117] | 128 | IF (llm==lmax) THEN |
---|
[1980] | 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 | |
---|
[5117] | 144 | ELSE IF (llm==1) THEN |
---|
[1980] | 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 | |
---|
[5117] | 162 | IF (ntime==1) THEN |
---|
[5088] | 163 | ierr = nf90_redef (nid) |
---|
| 164 | ierr = nf90_def_var(nid,nom,nf90_float,dim_cc,varid) |
---|
[5103] | 165 | !PRINT*,'DEF ',nom,nid,varid |
---|
[5088] | 166 | ierr = nf90_enddef(nid) |
---|
[1980] | 167 | else |
---|
[5088] | 168 | ierr= nf90_inq_varid(nid,nom,varid) |
---|
[5103] | 169 | !PRINT*,'INQ ',nom,nid,varid |
---|
[1980] | 170 | ! Commandes pour recuperer automatiquement les coordonnees |
---|
[5088] | 171 | ! ierr= nf90_inq_dimid(nid,"longitude",id(1)) |
---|
[1980] | 172 | endif |
---|
| 173 | |
---|
| 174 | |
---|
[5100] | 175 | ierr= nf90_put_var(nid,varid,zx,corner,edges) |
---|
[1980] | 176 | |
---|
[5117] | 177 | IF (ierr/=nf90_noerr) THEN |
---|
[5116] | 178 | WRITE(*,*) "***** PUT_VAR problem in writediagfi" |
---|
| 179 | WRITE(*,*) "***** with ",nom |
---|
| 180 | WRITE(*,*) 'ierr=', ierr |
---|
[1980] | 181 | endif |
---|
| 182 | |
---|
| 183 | |
---|
[5119] | 184 | END |
---|