source: trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/write_archive.F @ 1647

Last change on this file since 1647 was 1647, checked in by jvatant, 8 years ago

+ Major clean of the new LMDZ.TITAN from too-generic options and routines (water, co2, ocean, surface type ...)
+ From this revision LMDZ.TITAN begins to be really separated from LMDZ.GENERIC
+ Partial desactivation of aerosols, only the dummy case is still enabled to keep the code running ( new aerosol routines to come in followings commits )

JVO
File size: 7.9 KB
Line 
1c=======================================================================
2      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
10c   -----    dans un fichier DRS nomme "start_archive"
11c
12c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
13c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
14c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
15c    (ex: la longitude solaire)
16c
17c
18c   Arguments:
19c   ----------
20c
21c     Inputs:
22c     ------
23c
24c                 nid      Unite logique du fichier "start_archive"
25c         nom      nom du champ a ecrire dans le fichier "start_archive"
26c         titre    titre de la variable dans le fichier DRS "start_archive"
27c         unite    unite de la variable ....
28c         dim      dimension de la variable a ecrire
29c         px       tableau contenant la variable a ecrire
30c
31c
32c=======================================================================
33
34      use comsoil_h, only: nsoilmx
35
36      implicit none
37
38#include "dimensions.h"
39#include "paramet.h"
40#include "comgeom.h"
41#include "netcdf.inc"
42
43c-----------------------------------------------------------------------
44c       Declarations   
45c-----------------------------------------------------------------------
46
47c Arguments:
48
49      INTEGER nid
50      integer ntime ! time index
51      integer dim
52      REAL px(iip1,jjp1,llm)
53
54      CHARACTER*(*) nom, titre, unite
55
56      integer ierr
57
58
59c local
60      integer, dimension(4) :: edges,corner,id
61      integer :: varid,i,j,l
62c-----------------------------------------------------------------------
63c      Ecriture du champs dans le fichier            (3 cas)     
64c-----------------------------------------------------------------------
65
66! For an atmospheric 3D Variable
67!--------------------------------
68        if (dim.eq.3) then
69
70!         Ecriture du champs
71
72! nom de la variable
73           ierr= NF_INQ_VARID(nid,nom,varid)
74           if (ierr /= NF_NOERR) then
75! choix du nom des coordonnees
76              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
77              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
78              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
79              ierr= NF_INQ_DIMID(nid,"Time",id(4))
80
81! Creation de la variable si elle n'existait pas
82
83              write (*,*) "====================="
84              write (*,*) "creation de ",nom
85              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
86
87           endif
88
89! mars s'arranger pour qu'il n'y ai plus besoin de ca
90
91c          do l=1,llm
92c             do j=1,jjp1
93c                do i=1,iip1
94c                   pxbis(i,j,l)=px(i,j,llm-l+1)
95c                enddo
96c             enddo
97c          enddo
98           corner(1)=1
99           corner(2)=1
100           corner(3)=1
101           corner(4)=ntime
102
103           edges(1)=iip1
104           edges(2)=jjp1
105           edges(3)=llm
106           edges(4)=1
107#ifdef NC_DOUBLE
108           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
109#else
110           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
111#endif
112
113           if (ierr.ne.NF_NOERR) then
114              write(*,*) "***** PUT_VAR matter in write_archive"
115              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
116              call abort
117           endif
118
119
120! For a subterranean 3D Variable
121!-------------------------------
122
123        else if (dim.eq.-3) then
124        ! get variables' ID, if it exists
125        ierr=NF_INQ_VARID(nid,nom,varid)
126       
127         if (ierr.ne.NF_NOERR) then ! variable not defined yet
128          ! build related coordinates
129          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
130          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
131          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
132          if (ierr.ne.NF_NOERR) then
133           write(*,*)"write_archive: dimension <subsurface_layers>",
134     &               " is missing !!!"
135           call abort
136          endif
137          ierr=NF_INQ_DIMID(nid,"Time",id(4))
138         
139          ! define the variable
140          write(*,*)"====================="
141          write(*,*)"defining ",nom
142          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
143         
144         endif
145
146        ! build cedges and corners
147        corner(1)=1
148        corner(2)=1
149        corner(3)=1
150        corner(4)=ntime
151
152        edges(1)=iip1
153        edges(2)=jjp1
154        edges(3)=nsoilmx
155        edges(4)=1
156#ifdef NC_DOUBLE
157           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
158#else
159           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
160#endif
161
162! For a 3D ocean temperature Variable
163!-------------------------------
164
165        else if (dim.eq.-2) then
166        ! get variables' ID, if it exists
167        ierr=NF_INQ_VARID(nid,nom,varid)
168
169         if (ierr.ne.NF_NOERR) then ! variable not defined yet
170          ! build related coordinates
171          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
172          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
173          ierr=NF_INQ_DIMID(nid,"ocean_layers",id(3))
174          if (ierr.ne.NF_NOERR) then
175           write(*,*)"write_archive: dimension <ocean_layers>",
176     &               " is missing !!!"
177           call abort
178          endif
179          ierr=NF_INQ_DIMID(nid,"Time",id(4))
180
181          ! define the variable
182          write(*,*)"====================="
183          write(*,*)"defining ",nom
184          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
185
186         endif
187
188        ! build cedges and corners
189        corner(1)=1
190        corner(2)=1
191        corner(3)=1
192        corner(4)=ntime
193
194        edges(1)=iip1
195        edges(2)=jjp1
196        edges(3)=1 ! JVO2017 : was noceanmx before -> set to 1
197        edges(4)=1
198#ifdef NC_DOUBLE
199           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
200#else
201           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
202#endif
203
204
205
206! For a surface 2D Variable
207!--------------------------
208
209        else if (dim.eq.2) then
210
211!         Ecriture du champs
212
213           ierr= NF_INQ_VARID(nid,nom,varid)
214           if (ierr /= NF_NOERR) then
215!  choix du nom des coordonnees
216              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
217              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
218              ierr= NF_INQ_DIMID(nid,"Time",id(3))
219
220! Creation de la variable si elle n'existait pas
221
222              write (*,*) "====================="
223              write (*,*) "creation de ",nom
224
225              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
226
227           endif
228
229           corner(1)=1
230           corner(2)=1
231           corner(3)=ntime
232           edges(1)=iip1
233           edges(2)=jjp1
234           edges(3)=1
235
236
237#ifdef NC_DOUBLE
238           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
239#else         
240           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
241#endif     
242
243           if (ierr.ne.NF_NOERR) then
244              write(*,*) "***** PUT_VAR matter in write_archive"
245              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
246              call abort
247           endif
248
249
250!Cas Variable 0D (scalaire dependant du temps)
251!---------------------------------------------
252
253        else if (dim.eq.0) then
254
255!         Ecriture du champs
256
257           ierr= NF_INQ_VARID(nid,nom,varid)
258           if (ierr /= NF_NOERR) then
259!  choix du nom des coordonnees
260              ierr= NF_INQ_DIMID(nid,"Time",id(1))
261
262! Creation de la variable si elle n'existait pas
263
264              write (*,*) "====================="
265              write (*,*) "creation de ",nom
266
267              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
268
269           endif
270
271           corner(1)=ntime
272           edges(1)=1
273
274#ifdef NC_DOUBLE
275           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
276#else
277           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
278#endif
279           if (ierr.ne.NF_NOERR) then
280              write(*,*) "***** PUT_VAR matter in write_archive"
281              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
282              call abort
283           endif
284
285        else
286          write(*,*) "write_archive: dim=",dim," ?!?"
287          call abort
288        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
289
290      return
291      end
292
Note: See TracBrowser for help on using the repository browser.