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

Last change on this file since 5133 was 5119, checked in by abarral, 5 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.