source: trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/write_archive.F @ 2613

Last change on this file since 2613 was 2336, checked in by emillour, 5 years ago

Generic GCM:
Update start2archive/newstart programs to handle recently introduced
non-orographic GW variables in (re-)start files.
EM
File size: 8.0 KB
RevLine 
[135]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
[1216]34      use comsoil_h, only: nsoilmx
[1478]35      use slab_ice_h, only: noceanmx
36
[135]37      implicit none
38
[2336]39      include "dimensions.h"
40      include "paramet.h"
41      include "comgeom.h"
42      include "netcdf.inc"
[135]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
61      integer, dimension(4) :: edges,corner,id
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
83
84              write (*,*) "====================="
[2336]85              write (*,*) "defining ",nom
[135]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
[2336]115              write(*,*) "***** PUT_VAR problem in write_archive"
116              write(*,*) "***** with ",trim(nom)," ",nf_STRERROR(ierr)
[135]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)
127       
128         if (ierr.ne.NF_NOERR) then ! variable not defined yet
129          ! build related coordinates
130          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
131          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
132          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
133          if (ierr.ne.NF_NOERR) then
134           write(*,*)"write_archive: dimension <subsurface_layers>",
135     &               " is missing !!!"
136           call abort
137          endif
138          ierr=NF_INQ_DIMID(nid,"Time",id(4))
139         
140          ! define the variable
141          write(*,*)"====================="
[2336]142          write(*,*)"defining variable ",trim(nom)
[135]143          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
144         
145         endif
146
147        ! build cedges and corners
148        corner(1)=1
149        corner(2)=1
150        corner(3)=1
151        corner(4)=ntime
152
153        edges(1)=iip1
154        edges(2)=jjp1
155        edges(3)=nsoilmx
156        edges(4)=1
157#ifdef NC_DOUBLE
158           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
159#else
160           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
161#endif
162
[1478]163! For a 3D ocean temperature Variable
164!-------------------------------
[135]165
[1478]166        else if (dim.eq.-2) then
167        ! get variables' ID, if it exists
168        ierr=NF_INQ_VARID(nid,nom,varid)
169
170         if (ierr.ne.NF_NOERR) then ! variable not defined yet
171          ! build related coordinates
172          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
173          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
174          ierr=NF_INQ_DIMID(nid,"ocean_layers",id(3))
175          if (ierr.ne.NF_NOERR) then
176           write(*,*)"write_archive: dimension <ocean_layers>",
177     &               " is missing !!!"
178           call abort
179          endif
180          ierr=NF_INQ_DIMID(nid,"Time",id(4))
181
182          ! define the variable
183          write(*,*)"====================="
[2336]184          write(*,*)"defining variable ",trim(nom)
[1478]185          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
186
187         endif
188
189        ! build cedges and corners
190        corner(1)=1
191        corner(2)=1
192        corner(3)=1
193        corner(4)=ntime
194
195        edges(1)=iip1
196        edges(2)=jjp1
197        edges(3)=noceanmx
198        edges(4)=1
199#ifdef NC_DOUBLE
200           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
201#else
202           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
203#endif
204
205
206
[135]207! For a surface 2D Variable
208!--------------------------
209
210        else if (dim.eq.2) then
211
212!         Ecriture du champs
213
214           ierr= NF_INQ_VARID(nid,nom,varid)
215           if (ierr /= NF_NOERR) then
216!  choix du nom des coordonnees
217              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
218              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
219              ierr= NF_INQ_DIMID(nid,"Time",id(3))
220
221! Creation de la variable si elle n'existait pas
222
223              write (*,*) "====================="
[2336]224              write (*,*) "defining variable ",trim(nom)
[135]225
226              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
227
228           endif
229
230           corner(1)=1
231           corner(2)=1
232           corner(3)=ntime
233           edges(1)=iip1
234           edges(2)=jjp1
235           edges(3)=1
236
237
238#ifdef NC_DOUBLE
239           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
240#else         
241           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
242#endif     
243
244           if (ierr.ne.NF_NOERR) then
[2336]245              write(*,*) "***** PUT_VAR problem in write_archive"
[135]246              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
247              call abort
248           endif
249
250
251!Cas Variable 0D (scalaire dependant du temps)
252!---------------------------------------------
253
254        else if (dim.eq.0) then
255
256!         Ecriture du champs
257
258           ierr= NF_INQ_VARID(nid,nom,varid)
259           if (ierr /= NF_NOERR) then
260!  choix du nom des coordonnees
261              ierr= NF_INQ_DIMID(nid,"Time",id(1))
262
263! Creation de la variable si elle n'existait pas
264
265              write (*,*) "====================="
[2336]266              write (*,*) "defining variable ",trim(nom)
[135]267
268              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
269
270           endif
271
272           corner(1)=ntime
273           edges(1)=1
274
275#ifdef NC_DOUBLE
276           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
277#else
278           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
279#endif
280           if (ierr.ne.NF_NOERR) then
[2336]281              write(*,*) "***** PUT_VAR problem in write_archive"
[135]282              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
283              call abort
284           endif
285
286        else
287          write(*,*) "write_archive: dim=",dim," ?!?"
288          call abort
289        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
290
291      end
292
Note: See TracBrowser for help on using the repository browser.