source: LMDZ6/trunk/libf/phylmd/iotd_ecrit.F90 @ 5160

Last change on this file since 5160 was 5084, checked in by Laurent Fairhead, 4 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF

File size: 4.9 KB
RevLine 
[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 
[5084]24      use netcdf, only: nf90_put_var
[1980]25      implicit none
26
27! Commons
28
[5084]29      INCLUDE "netcdf.inc"
[4593]30      INCLUDE "iotd.h"
[1980]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
[3978]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
[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)
85        if (firstnom =='1234567890') then
86            firstnom=nom
87        endif
88
[3977]89       !print*,'nom ',nom,firstnom
[1980]90
91!! Quand on tombe sur la premiere variable on ajoute un pas de temps
[5084]92        if (nom.eq.firstnom) then
[1980]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
[3977]98           date=iotd_t0+ntime*iotd_ts
[3978]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
105           ierr=NF_SYNC(nid)
106
[3977]107           ierr= NF_INQ_VARID(nid,"time",varid)
108           ! Write (append) the new date to the 'time' array
[1980]109
110
[4259]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
[5084]116           if (ierr.ne.NF_NOERR) then
[1980]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)
[3978]165          !print*,'DEF ',nom,nid,varid
[1980]166          ierr = NF_ENDDEF(nid)
167      else
168         ierr= NF_INQ_VARID(nid,nom,varid)
[3978]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
[4259]175      ierr= NF90_PUT_VAR(nid,varid,zx,corner,edges)
[1980]176
[5084]177      if (ierr.ne.NF_NOERR) then
[1980]178           write(*,*) "***** PUT_VAR problem in writediagfi"
179           write(*,*) "***** with ",nom
180           write(*,*) 'ierr=', ierr
181      endif
182
183
184      end
Note: See TracBrowser for help on using the repository browser.