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

Last change on this file since 5233 was 5084, checked in by Laurent Fairhead, 12 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
Line 
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 
24      use netcdf, only: nf90_put_var
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
66
67       if (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) return
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
79! Compute/write/extend 'time' coordinate (date given in days)
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
89       !print*,'nom ',nom,firstnom
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
98           date=iotd_t0+ntime*iotd_ts
99           !print*,'iotd_ecrit ',iotd_ts,ntime, date
100!          date= float (zitau +1)/float (day_step)
101
102           ! compute corresponding date (in days and fractions thereof)
103           ! Get NetCDF ID of 'time' variable
104
105           ierr=NF_SYNC(nid)
106
107           ierr= NF_INQ_VARID(nid,"time",varid)
108           ! Write (append) the new date to the 'time' array
109
110
111           ierr= NF90_PUT_VAR(nid,varid,date,[ntime])
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)
165          !print*,'DEF ',nom,nid,varid
166          ierr = NF_ENDDEF(nid)
167      else
168         ierr= NF_INQ_VARID(nid,nom,varid)
169          !print*,'INQ ',nom,nid,varid
170! Commandes pour recuperer automatiquement les coordonnees
171!             ierr= NF_INQ_DIMID(nid,"longitude",id(1))
172      endif
173
174
175      ierr= NF90_PUT_VAR(nid,varid,zx,corner,edges)
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
Note: See TracBrowser for help on using the repository browser.