source: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F @ 3094

Last change on this file since 3094 was 2959, checked in by romain.vande, 20 months ago

Mars PCM :
Correct start2archive to write watercaptag correctly.
Watercaptag will be set to false and correctly handle by the PCM in the case where we change resolution.
+ Correct inertiesoil writting in start2archive
RV
File size: 9.4 KB
RevLine 
[38]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
[1047]34      use comsoil_h, only: nsoilmx
[2913]35      use comslope_mod, ONLY: nslope
[38]36      implicit none
37
38#include "dimensions.h"
39#include "paramet.h"
[1130]40!#include "control.h"
[38]41#include "comgeom.h"
42#include "netcdf.inc"
43
44c-----------------------------------------------------------------------
45c       Declarations   
46c-----------------------------------------------------------------------
47
48c Arguments:
49
50      INTEGER nid
51      integer ntime ! time index
52      integer dim
53      REAL px(iip1,jjp1,llm)
54
55      CHARACTER*(*) nom, titre, unite
56
57      integer ierr
58
59
60c local
[2913]61      integer, dimension(5) :: edges,corner,id
[38]62      integer :: varid,i,j,l
63c-----------------------------------------------------------------------
64c      Ecriture du champs dans le fichier            (3 cas)     
65c-----------------------------------------------------------------------
66
67! For an atmospheric 3D Variable
68!--------------------------------
69        if (dim.eq.3) then
70
71!         Ecriture du champs
72
73! nom de la variable
74           ierr= NF_INQ_VARID(nid,nom,varid)
75           if (ierr /= NF_NOERR) then
76! choix du nom des coordonnees
77              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
78              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
79              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
80              ierr= NF_INQ_DIMID(nid,"Time",id(4))
81
82! Creation de la variable si elle n'existait pas
[2943]83                   
[38]84              write (*,*) "====================="
85              write (*,*) "creation de ",nom
86              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
87
88           endif
89
90! mars s'arranger pour qu'il n'y ai plus besoin de ca
91
92c          do l=1,llm
93c             do j=1,jjp1
94c                do i=1,iip1
95c                   pxbis(i,j,l)=px(i,j,llm-l+1)
96c                enddo
97c             enddo
98c          enddo
99           corner(1)=1
100           corner(2)=1
101           corner(3)=1
102           corner(4)=ntime
103
104           edges(1)=iip1
105           edges(2)=jjp1
106           edges(3)=llm
107           edges(4)=1
108#ifdef NC_DOUBLE
109           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
110#else
111           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
112#endif
113
114           if (ierr.ne.NF_NOERR) then
115              write(*,*) "***** PUT_VAR matter in write_archive"
116              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
117              call abort
118           endif
119
120
121! For a subterranean 3D Variable
122!-------------------------------
123
124        else if (dim.eq.-3) then
125        ! get variables' ID, if it exists
126        ierr=NF_INQ_VARID(nid,nom,varid)
[2913]127
[2952]128        if(nom.eq."tsoil" .or. nom.eq."inertiesoil") then
[2913]129
130         if (ierr.ne.NF_NOERR) then ! variable not defined yet
131          ! build related coordinates
132          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
133          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
134          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
135          if (ierr.ne.NF_NOERR) then
136           write(*,*)"write_archive: dimension <subsurface_layers>",
137     &               " is missing !!!"
138           call abort
139          endif
140          ierr=NF_INQ_DIMID(nid,"nslope",id(4))
141          if (ierr.ne.NF_NOERR) then
142           write(*,*)"write_archive: dimension <nslope>",
143     &               " is missing !!!"
144           call abort
145          endif
146          ierr=NF_INQ_DIMID(nid,"Time",id(5))
147         
148          ! define the variable
149          write(*,*)"====================="
150          write(*,*)"defining ",nom
151          call def_var(nid,nom,titre,unite,5,id,varid,ierr)
152         
153         endif
154
155        ! build cedges and corners
156        corner(1)=1
157        corner(2)=1
158        corner(3)=1
159        corner(4)=1
160        corner(5)=ntime
161
162        edges(1)=iip1
163        edges(2)=jjp1
164        edges(3)=nsoilmx
165        edges(4)=nslope
166        edges(5)=1
167
168#ifdef NC_DOUBLE
169           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
170#else
171           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
172#endif
173
174        else
[38]175       
176         if (ierr.ne.NF_NOERR) then ! variable not defined yet
177          ! build related coordinates
178          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
179          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
180          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
181          if (ierr.ne.NF_NOERR) then
182           write(*,*)"write_archive: dimension <subsurface_layers>",
183     &               " is missing !!!"
184           call abort
185          endif
186          ierr=NF_INQ_DIMID(nid,"Time",id(4))
187         
188          ! define the variable
189          write(*,*)"====================="
190          write(*,*)"defining ",nom
191          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
192         
193         endif
194
195        ! build cedges and corners
196        corner(1)=1
197        corner(2)=1
198        corner(3)=1
199        corner(4)=ntime
200
201        edges(1)=iip1
202        edges(2)=jjp1
203        edges(3)=nsoilmx
204        edges(4)=1
205#ifdef NC_DOUBLE
206           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
207#else
208           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
209#endif
210
[2913]211       endif
[38]212
[2913]213
[38]214! For a surface 2D Variable
215!--------------------------
216
217        else if (dim.eq.2) then
218
219!         Ecriture du champs
220
221           ierr= NF_INQ_VARID(nid,nom,varid)
[2913]222
223           if(nom.eq."tauscaling" .or. nom.eq."totcloudfrac" .or.
[2914]224     &        nom.eq."ps" .or. nom.eq."q2surf" .or. nom.eq."ZMEA" .or.
225     &        nom.eq."ZSTD" .or. nom.eq."ZSIG" .or. nom.eq."ZTHE" .or.
[2943]226     &        nom.eq."ZGAM" .or. nom.eq."albedodat" .or.
[2914]227     &        nom.eq."z0" .or. nom.eq."summit" .or. nom.eq."hmons"
[2959]228     &        .or. nom.eq."base".or. nom.eq."watercaptag") then
[2913]229
[38]230           if (ierr /= NF_NOERR) then
231!  choix du nom des coordonnees
232              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
233              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
234              ierr= NF_INQ_DIMID(nid,"Time",id(3))
235
236! Creation de la variable si elle n'existait pas
237
238              write (*,*) "====================="
239              write (*,*) "creation de ",nom
240              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
241
242           endif
243
244           corner(1)=1
245           corner(2)=1
246           corner(3)=ntime
247           edges(1)=iip1
248           edges(2)=jjp1
249           edges(3)=1
250
251
252#ifdef NC_DOUBLE
253           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
254#else         
255           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
256#endif     
257
258           if (ierr.ne.NF_NOERR) then
259              write(*,*) "***** PUT_VAR matter in write_archive"
260              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
261              call abort
262           endif
[2913]263 
264       else
[38]265
[2913]266           if (ierr /= NF_NOERR) then
267!  choix du nom des coordonnees
268              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
269              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
270              ierr= NF_INQ_DIMID(nid,"nslope",id(3))
271              ierr= NF_INQ_DIMID(nid,"Time",id(4))
[38]272
[2913]273! Creation de la variable si elle n'existait pas
274
275              write (*,*) "====================="
276              write (*,*) "creation de ",nom
277              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
278
279           endif
280
281           corner(1)=1
282           corner(2)=1
283           corner(3)=1
284           corner(4)=ntime
285
286           edges(1)=iip1
287           edges(2)=jjp1
288           edges(3)=nslope
289           edges(4)=1
290
291
292#ifdef NC_DOUBLE
293           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
294#else         
295           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
296#endif     
297
298           if (ierr.ne.NF_NOERR) then
299              write(*,*) "***** PUT_VAR matter in write_archive"
300              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
301              call abort
302           endif
303
304       endif
305
306
[38]307!Cas Variable 0D (scalaire dependant du temps)
308!---------------------------------------------
309
310        else if (dim.eq.0) then
311
312!         Ecriture du champs
313
314           ierr= NF_INQ_VARID(nid,nom,varid)
315           if (ierr /= NF_NOERR) then
316!  choix du nom des coordonnees
317              ierr= NF_INQ_DIMID(nid,"Time",id(1))
318
319! Creation de la variable si elle n'existait pas
320
321              write (*,*) "====================="
322              write (*,*) "creation de ",nom
323              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
324
325           endif
326
327           corner(1)=ntime
328           edges(1)=1
329
330#ifdef NC_DOUBLE
331           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
332#else
333           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
334#endif
335           if (ierr.ne.NF_NOERR) then
336              write(*,*) "***** PUT_VAR matter in write_archive"
337              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
338              call abort
339           endif
340
341        else
342          write(*,*) "write_archive: dim=",dim," ?!?"
343          call abort
344        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
345
346      return
347      end
348
Note: See TracBrowser for help on using the repository browser.