source: LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90 @ 5132

Last change on this file since 5132 was 5119, checked in by abarral, 11 months ago

enforce PRIVATE by default in several modules, expose PUBLIC as needed
move eigen.f90 to obsolete/
(lint) aslong the way

File size: 5.0 KB
RevLine 
[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
Note: See TracBrowser for help on using the repository browser.