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

Last change on this file since 1242 was 1208, checked in by tnavarro, 11 years ago

added tauscaling in startfi + moved start_archive routines from dyn3d to phymars
File size: 6.8 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
[38]35      implicit none
36
37#include "dimensions.h"
38#include "dimphys.h"
39#include "paramet.h"
[1130]40!#include "control.h"
[38]41#include "comvert.h"
42#include "comgeom.h"
43#include "description.h"
44#include "temps.h"
45#include "netcdf.inc"
46
47c-----------------------------------------------------------------------
48c       Declarations   
49c-----------------------------------------------------------------------
50
51c Arguments:
52
53      INTEGER nid
54      integer ntime ! time index
55      integer dim
56      REAL px(iip1,jjp1,llm)
57
58      CHARACTER*(*) nom, titre, unite
59
60      integer ierr
61
62
63c local
64      integer, dimension(4) :: edges,corner,id
65      integer :: varid,i,j,l
66c-----------------------------------------------------------------------
67c      Ecriture du champs dans le fichier            (3 cas)     
68c-----------------------------------------------------------------------
69
70! For an atmospheric 3D Variable
71!--------------------------------
72        if (dim.eq.3) then
73
74!         Ecriture du champs
75
76! nom de la variable
77           ierr= NF_INQ_VARID(nid,nom,varid)
78           if (ierr /= NF_NOERR) then
79! choix du nom des coordonnees
80              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
81              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
82              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
83              ierr= NF_INQ_DIMID(nid,"Time",id(4))
84
85! Creation de la variable si elle n'existait pas
86
87              write (*,*) "====================="
88              write (*,*) "creation de ",nom
89              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
90
91           endif
92
93! mars s'arranger pour qu'il n'y ai plus besoin de ca
94
95c          do l=1,llm
96c             do j=1,jjp1
97c                do i=1,iip1
98c                   pxbis(i,j,l)=px(i,j,llm-l+1)
99c                enddo
100c             enddo
101c          enddo
102           corner(1)=1
103           corner(2)=1
104           corner(3)=1
105           corner(4)=ntime
106
107           edges(1)=iip1
108           edges(2)=jjp1
109           edges(3)=llm
110           edges(4)=1
111#ifdef NC_DOUBLE
112           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
113#else
114           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
115#endif
116
117           if (ierr.ne.NF_NOERR) then
118              write(*,*) "***** PUT_VAR matter in write_archive"
119              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
120              call abort
121           endif
122
123
124! For a subterranean 3D Variable
125!-------------------------------
126
127        else if (dim.eq.-3) then
128        ! get variables' ID, if it exists
129        ierr=NF_INQ_VARID(nid,nom,varid)
130       
131         if (ierr.ne.NF_NOERR) then ! variable not defined yet
132          ! build related coordinates
133          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
134          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
135          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
136          if (ierr.ne.NF_NOERR) then
137           write(*,*)"write_archive: dimension <subsurface_layers>",
138     &               " is missing !!!"
139           call abort
140          endif
141          ierr=NF_INQ_DIMID(nid,"Time",id(4))
142         
143          ! define the variable
144          write(*,*)"====================="
145          write(*,*)"defining ",nom
146          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
147         
148         endif
149
150        ! build cedges and corners
151        corner(1)=1
152        corner(2)=1
153        corner(3)=1
154        corner(4)=ntime
155
156        edges(1)=iip1
157        edges(2)=jjp1
158        edges(3)=nsoilmx
159        edges(4)=1
160#ifdef NC_DOUBLE
161           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
162#else
163           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
164#endif
165
166
167! For a surface 2D Variable
168!--------------------------
169
170        else if (dim.eq.2) then
171
172!         Ecriture du champs
173
174           ierr= NF_INQ_VARID(nid,nom,varid)
175           if (ierr /= NF_NOERR) then
176!  choix du nom des coordonnees
177              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
178              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
179              ierr= NF_INQ_DIMID(nid,"Time",id(3))
180
181! Creation de la variable si elle n'existait pas
182
183              write (*,*) "====================="
184              write (*,*) "creation de ",nom
185
186              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
187
188           endif
189
190           corner(1)=1
191           corner(2)=1
192           corner(3)=ntime
193           edges(1)=iip1
194           edges(2)=jjp1
195           edges(3)=1
196
197
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           if (ierr.ne.NF_NOERR) then
205              write(*,*) "***** PUT_VAR matter in write_archive"
206              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
207              call abort
208           endif
209
210
211!Cas Variable 0D (scalaire dependant du temps)
212!---------------------------------------------
213
214        else if (dim.eq.0) then
215
216!         Ecriture du champs
217
218           ierr= NF_INQ_VARID(nid,nom,varid)
219           if (ierr /= NF_NOERR) then
220!  choix du nom des coordonnees
221              ierr= NF_INQ_DIMID(nid,"Time",id(1))
222
223! Creation de la variable si elle n'existait pas
224
225              write (*,*) "====================="
226              write (*,*) "creation de ",nom
227
228              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
229
230           endif
231
232           corner(1)=ntime
233           edges(1)=1
234
235#ifdef NC_DOUBLE
236           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
237#else
238           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
239#endif
240           if (ierr.ne.NF_NOERR) then
241              write(*,*) "***** PUT_VAR matter in write_archive"
242              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
243              call abort
244           endif
245
246        else
247          write(*,*) "write_archive: dim=",dim," ?!?"
248          call abort
249        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
250
251      return
252      end
253
Note: See TracBrowser for help on using the repository browser.