source: trunk/mesoscale/LMDZ.MARS/libf_gcm/dyn3d/dynetat0.F @ 83

Last change on this file since 83 was 57, checked in by aslmd, 15 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)
File size: 11.7 KB
RevLine 
[57]1      SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
2     .                    teta,q,masse,ps,phis,time)
3      IMPLICIT NONE
4
5c=======================================================================
6c
7c   Auteur:  P. Le Van / L.Fairhead
8c   -------
9c
10c   objet:
11c   ------
12c
13c   Lecture de l'etat initial
14c
15c=======================================================================
16c-----------------------------------------------------------------------
17c   Declarations:
18c   -------------
19
20#include "dimensions.h"
21#include "paramet.h"
22#include "temps.h"
23#include "comconst.h"
24#include "comvert.h"
25#include "comgeom.h"
26#include "ener.h"
27#include "netcdf.inc"
28#include "description.h"
29#include "serre.h"
30#include "logic.h"
31
32c   Arguments:
33c   ----------
34
35      CHARACTER*(*) fichnom
36      INTEGER nq
37      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
38      REAL q(iip1,jjp1,llm,nq),masse(ip1jmp1,llm)
39      REAL ps(ip1jmp1),phis(ip1jmp1)
40
41      REAL time
42
43c   Variables
44c
45      INTEGER length,iq,i,j,l
46      PARAMETER (length = 100)
47      REAL tab_cntrl(length) ! tableau des parametres du run
48      INTEGER ierr, nid, nvarid, nqold
49      CHARACTER  str3*3,yes*1
50
51c-----------------------------------------------------------------------
52
53c  Ouverture NetCDF du fichier etat initial
54
55      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
56      IF (ierr.NE.NF_NOERR) THEN
57        write(6,*)' Pb d''ouverture du fichier ',fichnom
58        CALL ABORT
59      ENDIF
60
61c
62      ierr = NF_INQ_VARID (nid, "controle", nvarid)
63      IF (ierr .NE. NF_NOERR) THEN
64         PRINT*, "dynetat0: Le champ <controle> est absent"
65         CALL abort
66      ENDIF
67#ifdef NC_DOUBLE
68      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
69#else
70      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
71#endif
72      IF (ierr .NE. NF_NOERR) THEN
73         PRINT*, "dynetat0: Lecture echoue pour <controle>"
74         CALL abort
75      ENDIF
76
77      im         = tab_cntrl(1)
78      jm         = tab_cntrl(2)
79      lllm       = tab_cntrl(3)
80      day_ini    = tab_cntrl(4)
81      rad        = tab_cntrl(5)
82      omeg       = tab_cntrl(6)
83      g          = tab_cntrl(7)
84      cpp        = tab_cntrl(8)
85      kappa      = tab_cntrl(9)
86      daysec     = tab_cntrl(10)
87      dtvr       = tab_cntrl(11)
88      etot0      = tab_cntrl(12)
89      ptot0      = tab_cntrl(13)
90      ztot0      = tab_cntrl(14)
91      stot0      = tab_cntrl(15)
92      ang0       = tab_cntrl(16)
93      pa         = tab_cntrl(17)
94      preff      = tab_cntrl(18)
95c
96      clon       = tab_cntrl(19)
97      clat       = tab_cntrl(20)
98      grossismx  = tab_cntrl(21)
99      grossismy  = tab_cntrl(22)
100c
101      IF ( tab_cntrl(23).EQ.1. )  THEN
102        fxyhypb  = . TRUE .
103        dzoomx   = tab_cntrl(24)
104        dzoomy   = tab_cntrl(25)
105        taux     = tab_cntrl(27)
106        tauy     = tab_cntrl(28)
107      ELSE
108        fxyhypb = . FALSE .
109        ysinus  = . FALSE .
110        IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE.
111      ENDIF
112c   .................................................................
113c
114c
115      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
116 
117      IF(   im.ne.iim           )  THEN
118          PRINT 1,im,iim
119          STOP
120      ELSE  IF( jm.ne.jjm       )  THEN
121          PRINT 2,jm,jjm
122          STOP
123      ELSE  IF( lllm.ne.llm     )  THEN
124          PRINT 3,lllm,llm
125          STOP
126      ENDIF
127
128      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
129      IF (ierr .NE. NF_NOERR) THEN
130         PRINT*, "dynetat0: Le champ <rlonu> est absent"
131         CALL abort
132      ENDIF
133#ifdef NC_DOUBLE
134      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
135#else
136      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
137#endif
138      IF (ierr .NE. NF_NOERR) THEN
139         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
140         CALL abort
141      ENDIF
142
143      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
144      IF (ierr .NE. NF_NOERR) THEN
145         PRINT*, "dynetat0: Le champ <rlatu> est absent"
146         CALL abort
147      ENDIF
148#ifdef NC_DOUBLE
149      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
150#else
151      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
152#endif
153      IF (ierr .NE. NF_NOERR) THEN
154         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
155         CALL abort
156      ENDIF
157
158      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
159      IF (ierr .NE. NF_NOERR) THEN
160         PRINT*, "dynetat0: Le champ <rlonv> est absent"
161         CALL abort
162      ENDIF
163#ifdef NC_DOUBLE
164      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
165#else
166      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
167#endif
168      IF (ierr .NE. NF_NOERR) THEN
169         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
170         CALL abort
171      ENDIF
172
173      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
174      IF (ierr .NE. NF_NOERR) THEN
175         PRINT*, "dynetat0: Le champ <rlatv> est absent"
176         CALL abort
177      ENDIF
178#ifdef NC_DOUBLE
179      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
180#else
181      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
182#endif
183      IF (ierr .NE. NF_NOERR) THEN
184         PRINT*, "dynetat0: Lecture echouee pour rlatv"
185         CALL abort
186      ENDIF
187
188      ierr = NF_INQ_VARID (nid, "cu", nvarid)
189      IF (ierr .NE. NF_NOERR) THEN
190         PRINT*, "dynetat0: Le champ <cu> est absent"
191         CALL abort
192      ENDIF
193#ifdef NC_DOUBLE
194      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
195#else
196      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
197#endif
198      IF (ierr .NE. NF_NOERR) THEN
199         PRINT*, "dynetat0: Lecture echouee pour <cu>"
200         CALL abort
201      ENDIF
202
203      ierr = NF_INQ_VARID (nid, "cv", nvarid)
204      IF (ierr .NE. NF_NOERR) THEN
205         PRINT*, "dynetat0: Le champ <cv> est absent"
206         CALL abort
207      ENDIF
208#ifdef NC_DOUBLE
209      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
210#else
211      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
212#endif
213      IF (ierr .NE. NF_NOERR) THEN
214         PRINT*, "dynetat0: Lecture echouee pour <cv>"
215         CALL abort
216      ENDIF
217
218      ierr = NF_INQ_VARID (nid, "aire", nvarid)
219      IF (ierr .NE. NF_NOERR) THEN
220         PRINT*, "dynetat0: Le champ <aire> est absent"
221         CALL abort
222      ENDIF
223#ifdef NC_DOUBLE
224      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
225#else
226      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
227#endif
228      IF (ierr .NE. NF_NOERR) THEN
229         PRINT*, "dynetat0: Lecture echouee pour <aire>"
230         CALL abort
231      ENDIF
232
233      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
234      IF (ierr .NE. NF_NOERR) THEN
235         PRINT*, "dynetat0: Le champ <phisinit> est absent"
236         CALL abort
237      ENDIF
238#ifdef NC_DOUBLE
239      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
240#else
241      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
242#endif
243      IF (ierr .NE. NF_NOERR) THEN
244         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
245         CALL abort
246      ENDIF
247
248      ierr = NF_INQ_VARID (nid, "Time", nvarid)
249      IF (ierr .NE. NF_NOERR) THEN
250             ierr = NF_INQ_VARID (nid, "temps", nvarid)
251                 IF (ierr .NE. NF_NOERR) THEN
252           PRINT*, "dynetat0: <Time> or <temps> absent"
253           CALL abort
254         ENDIF
255      ENDIF
256#ifdef NC_DOUBLE
257      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
258#else
259      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
260#endif
261      IF (ierr .NE. NF_NOERR) THEN
262         PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
263         CALL abort
264      ENDIF
265
266      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
267      IF (ierr .NE. NF_NOERR) THEN
268         PRINT*, "dynetat0: Le champ <ucov> est absent"
269         CALL abort
270      ENDIF
271#ifdef NC_DOUBLE
272      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
273#else
274      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
275#endif
276      IF (ierr .NE. NF_NOERR) THEN
277         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
278         CALL abort
279      ENDIF
280 
281      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
282      IF (ierr .NE. NF_NOERR) THEN
283         PRINT*, "dynetat0: Le champ <vcov> est absent"
284         CALL abort
285      ENDIF
286#ifdef NC_DOUBLE
287      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
288#else
289      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
290#endif
291      IF (ierr .NE. NF_NOERR) THEN
292         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
293         CALL abort
294      ENDIF
295
296      ierr = NF_INQ_VARID (nid, "teta", nvarid)
297      IF (ierr .NE. NF_NOERR) THEN
298         PRINT*, "dynetat0: Le champ <teta> est absent"
299         CALL abort
300      ENDIF
301#ifdef NC_DOUBLE
302      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
303#else
304      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
305#endif
306      IF (ierr .NE. NF_NOERR) THEN
307         PRINT*, "dynetat0: Lecture echouee pour <teta>"
308         CALL abort
309      ENDIF
310
311
312      IF(nq.GE.1) THEN
313
314         IF(nq.GT.99) THEN
315            PRINT*, "Trop de traceurs"
316            CALL abort
317         ENDIF
318         nqold=nq
319         DO iq=1,nq
320           str3(1:1)='q'
321           WRITE(str3(2:3),'(i2.2)') iq
322           ierr =  NF_INQ_VARID (nid, str3, nvarid)
323           IF (ierr .NE. NF_NOERR) THEN
324              PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
325              PRINT*, "          Il est donc initialise a zero"
326              CALL initial0(ijp1llm,q(1,1,1,iq))
327              nqold=min(iq-1,nqold)
328           ELSE
329#ifdef NC_DOUBLE
330           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
331#else
332           ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
333#endif
334              IF (ierr .NE. NF_NOERR) THEN
335                 PRINT*, "dynetat0: Lecture echouee pour "//str3
336                 CALL abort
337              ENDIF
338           ENDIF
339         ENDDO
340         if(nqold.lt.nq) then   
341c        case when new tracer are added in addition to old ones
342             write(*,*)'tracers 1 to ', nqold,'were already present'
343             write(*,*)'tracers ', nqold+1,' to ', nqmx,'are new'
344             yes=' '
345            do while ((yes.ne.'y').and.(yes.ne.'n'))
346             write(*,*) 'Would you like to reindex tracer # 1 ->',nqold
347             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
348             read(*,fmt='(a)') yes
349            end do
350            if (yes.eq.'y') then
351              write(*,*) 'OK, let s reindex the tracers'
352              do l=1,llm
353                do j=1,jjp1
354                  do i=1,iip1
355                    do iq=nqmx,nqmx-nqold+1,-1
356                       q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)   
357                    end do
358                    do iq=nqmx-nqold,1,-1
359                       q(i,j,l,iq)= 0.
360                    end do
361                  end do
362                end do
363              end do
364            end if
365         end if
366      ENDIF
367
368      ierr = NF_INQ_VARID (nid, "masse", nvarid)
369      IF (ierr .NE. NF_NOERR) THEN
370         PRINT*, "dynetat0: Le champ <masse> est absent"
371         CALL abort
372      ENDIF
373#ifdef NC_DOUBLE
374      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
375#else
376      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
377#endif
378      IF (ierr .NE. NF_NOERR) THEN
379         PRINT*, "dynetat0: Lecture echouee pour <masse>"
380         CALL abort
381      ENDIF
382
383      ierr = NF_INQ_VARID (nid, "ps", nvarid)
384      IF (ierr .NE. NF_NOERR) THEN
385         PRINT*, "dynetat0: Le champ <ps> est absent"
386         CALL abort
387      ENDIF
388#ifdef NC_DOUBLE
389      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
390#else
391      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
392#endif
393      IF (ierr .NE. NF_NOERR) THEN
394         PRINT*, "dynetat0: Lecture echouee pour <ps>"
395         CALL abort
396      ENDIF
397
398      ierr = NF_CLOSE(nid)
399
400       day_ini=day_ini+INT(time)
401       time=time-INT(time)
402
403  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
404     *arrage est differente de la valeur parametree iim =',i4//)
405   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
406     *arrage est differente de la valeur parametree jjm =',i4//)
407   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
408     *rrage est differente de la valeur parametree llm =',i4//)
409   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
410     *rrage est differente de la valeur  dtinteg =',i4//)
411
412      RETURN
413      END
Note: See TracBrowser for help on using the repository browser.