/[lmdze]/trunk/dyn3d/dynetat0.f
ViewVC logotype

Diff of /trunk/dyn3d/dynetat0.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/dynetat0.f90 revision 9 by guez, Mon Mar 31 13:58:05 2008 UTC trunk/dyn3d/dynetat0.f revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 1  Line 1 
1  module dynetat0_m  module dynetat0_m
2    
3    ! This module is clean: no C preprocessor directive, no include line.    use dimensions, only: iim, jjm
4    
5    IMPLICIT NONE    IMPLICIT NONE
6    
7  contains    private iim, jjm
8    
9      INTEGER day_ini
10      ! day number at the beginning of the run, based at value 1 on
11      ! January 1st of annee_ref
12    
13      integer:: day_ref = 1 ! jour de l'ann\'ee de l'\'etat initial
14      ! (= 350 si 20 d\'ecembre par exemple)
15    
16      integer:: annee_ref = 1998 ! Annee de l'etat initial (avec 4 chiffres)
17    
18      REAL clon ! longitude of the center of the zoom, in rad
19      real clat ! latitude of the center of the zoom, in rad
20    
21      real grossismx, grossismy
22      ! facteurs de grossissement du zoom, selon la longitude et la latitude
23      ! = 2 si 2 fois, = 3 si 3 fois, etc.
24    
25      real dzoomx, dzoomy
26      ! extensions en longitude et latitude de la zone du zoom (fractions
27      ! de la zone totale)
28    
29      real taux, tauy
30      ! raideur de la transition de l'int\'erieur \`a l'ext\'erieur du zoom
31      
32      real rlatu(jjm + 1)
33      ! latitudes of points of the "scalar" and "u" grid, in rad
34    
35      real rlatv(jjm)
36      ! latitudes of points of the "v" grid, in rad, in decreasing order
37    
38      real rlonu(iim + 1) ! longitudes of points of the "u" grid, in rad
39    
40    SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis, time)    real rlonv(iim + 1)
41      ! longitudes of points of the "scalar" and "v" grid, in rad
42    
43      ! From dynetat0.F, version 1.2 2004/06/22 11:45:30    real xprimu(iim + 1), xprimv(iim + 1)
44      ! 2 pi / iim * (derivative of the longitudinal zoom function)(rlon[uv])
45    
46      ! Authors:  P. Le Van, L. Fairhead    REAL xprimm025(iim + 1), xprimp025(iim + 1)
47      ! Objet : lecture de l'état initial    REAL rlatu1(jjm), rlatu2(jjm), yprimu1(jjm), yprimu2(jjm)
48      REAL ang0, etot0, ptot0, ztot0, stot0
49    
50      use dimens_m, only: iim, jjm, llm, nqmx    save
51      use comconst, only: im, cpp, dtvr, g, kappa, jm, lllm, omeg, rad  
52      use comvert, only: pa  contains
53      use logic, only: fxyhypb, ysinus  
54      use comgeom, only: rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d    SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis)
55      use serre, only: clon, clat, grossismy, grossismx  
56      use temps, only: day_ref, day_ini, itau_dyn, annee_ref      ! From dynetat0.F, version 1.2, 2004/06/22 11:45:30
57      use ener, only: etot0, ang0, ptot0, stot0, ztot0      ! Authors: P. Le Van, L. Fairhead
58      use advtrac_m, only: tname      ! This procedure reads the initial state of the atmosphere.
59      use netcdf95, only: nf95_open, nf95_inq_varid, handle_err, NF95_CLOSE  
60      use netcdf, only: NF90_NOWRITE, NF90_GET_VAR, NF90_NOERR      use comconst, only: dtvr
61      use nrutil, only: assert      use conf_gcm_m, only: raz_date
62        use dimensions, only: iim, jjm, llm, nqmx
63      !   Arguments:      use disvert_m, only: pa
64      REAL, intent(out):: vcov(: , :), ucov(:, :), teta(:, :)      use iniadvtrac_m, only: tname
65      REAL, intent(out):: q(:, :, :), masse(:, :)      use netcdf, only: NF90_NOWRITE, NF90_NOERR
66      REAL, intent(out):: ps(:), phis(:, :)      use netcdf95, only: NF95_GET_VAR, nf95_open, nf95_inq_varid, NF95_CLOSE, &
67      REAL, intent(out):: time           NF95_Gw_VAR
68        use nr_util, only: assert
69      !   Variables      use temps, only: itau_dyn
70      INTEGER length, iq      use unit_nml_m, only: unit_nml
71      PARAMETER (length = 100)  
72      REAL tab_cntrl(length) ! tableau des parametres du run      REAL, intent(out):: vcov(: , :, :) ! (iim + 1, jjm, llm)
73      INTEGER ierr, nid, nvarid      REAL, intent(out):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
74        REAL, intent(out):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
75        REAL, intent(out):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
76        REAL, intent(out):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
77        REAL, intent(out):: ps(:, :) ! (iim + 1, jjm + 1) in Pa
78        REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
79    
80        ! Local variables:
81        INTEGER iq
82        REAL, allocatable:: tab_cntrl(:) ! tableau des param\`etres du run
83        INTEGER ierr, ncid, varid
84    
85        namelist /dynetat0_nml/ day_ref, annee_ref
86    
87      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
88    
89      print *, "Call sequence information: dynetat0"      print *, "Call sequence information: dynetat0"
90    
91      call assert(size(vcov, 1) == (iim + 1) * jjm, "dynetat0 vcov 1")      call assert((/size(ucov, 1), size(vcov, 1), size(masse, 1), size(ps, 1), &
92      call assert((/size(ucov, 1), size(teta, 1), size(q, 1), size(masse, 1), &           size(phis, 1), size(q, 1), size(teta, 1)/) == iim + 1, "dynetat0 iim")
93           size(ps)/) == (iim + 1) * (jjm + 1), "dynetat0 (iim + 1) * (jjm + 1)")      call assert((/size(ucov, 2), size(vcov, 2) + 1, size(masse, 2), &
94      call assert(shape(phis) == (/iim + 1, jjm + 1/), "dynetat0 phis")           size(ps, 2), size(phis, 2), size(q, 2), size(teta, 2)/) == jjm + 1, &
95      call assert((/size(vcov, 2), size(ucov, 2), size(teta, 2), size(q, 2), &           "dynetat0 jjm")
96           size(masse, 2)/) == llm, "dynetat0 llm")      call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(q, 3), &
97      call assert(size(q, 3) == nqmx, "dynetat0 q 3")           size(masse, 3)/) == llm, "dynetat0 llm")
98        call assert(size(q, 4) == nqmx, "dynetat0 q nqmx")
99      ! Fichier état initial :  
100      call nf95_open("start.nc", NF90_NOWRITE, nid)      ! Fichier \'etat initial :
101        call nf95_open("start.nc", NF90_NOWRITE, ncid)
102      call nf95_inq_varid(nid, "controle", nvarid)  
103      ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)      call nf95_inq_varid(ncid, "controle", varid)
104      call handle_err("dynetat0, controle", ierr, nid)      call NF95_Gw_VAR(ncid, varid, tab_cntrl)
105    
106      im         = int(tab_cntrl(1))      call assert(int(tab_cntrl(1)) == iim, "dynetat0 tab_cntrl iim")
107      jm         = int(tab_cntrl(2))      call assert(int(tab_cntrl(2)) == jjm, "dynetat0 tab_cntrl jjm")
108      lllm       = int(tab_cntrl(3))      call assert(int(tab_cntrl(3)) == llm, "dynetat0 tab_cntrl llm")
109      day_ref    = int(tab_cntrl(4))  
110      annee_ref  = int(tab_cntrl(5))      IF (dtvr /= tab_cntrl(12)) THEN
111      omeg       = tab_cntrl(7)         print *, 'Warning: the time steps from day_step and "start.nc" ' // &
112      dtvr       = tab_cntrl(12)              'are different.'
113      etot0      = tab_cntrl(13)         print *, 'dtvr from day_step: ', dtvr
114      ptot0      = tab_cntrl(14)         print *, 'dtvr from "start.nc": ', tab_cntrl(12)
115      ztot0      = tab_cntrl(15)         print *, 'Using the value from day_step.'
     stot0      = tab_cntrl(16)  
     ang0       = tab_cntrl(17)  
     pa         = tab_cntrl(18)  
     clon       = tab_cntrl(20)  
     clat       = tab_cntrl(21)  
     grossismx  = tab_cntrl(22)  
     grossismy  = tab_cntrl(23)  
   
     IF (tab_cntrl(24) == 1.)  THEN  
        fxyhypb  = .TRUE.  
     ELSE  
        fxyhypb = .FALSE.  
        ysinus  = .FALSE.  
        IF (tab_cntrl(27) == 1.) ysinus = .TRUE.  
116      ENDIF      ENDIF
117    
118      day_ini = tab_cntrl(30)      etot0 = tab_cntrl(13)
119      itau_dyn = tab_cntrl(31)      ptot0 = tab_cntrl(14)
120        ztot0 = tab_cntrl(15)
121        stot0 = tab_cntrl(16)
122        ang0 = tab_cntrl(17)
123        pa = tab_cntrl(18)
124    
125        clon = tab_cntrl(20)
126        clat = tab_cntrl(21)
127        grossismx = tab_cntrl(22)
128        grossismy = tab_cntrl(23)
129        dzoomx = tab_cntrl(25)
130        dzoomy = tab_cntrl(26)
131        taux = tab_cntrl(28)
132        tauy = tab_cntrl(29)
133    
134        print *, "Enter namelist 'dynetat0_nml'."
135        read(unit=*, nml=dynetat0_nml)
136        write(unit_nml, nml=dynetat0_nml)
137    
138        if (raz_date) then
139           print *, 'Resetting the date, using the namelist.'
140           day_ini = day_ref
141           itau_dyn = 0
142        else
143           day_ref = tab_cntrl(4)
144           annee_ref = tab_cntrl(5)
145           itau_dyn = tab_cntrl(31)
146           day_ini = tab_cntrl(30)
147        end if
148    
149        print *, "day_ini = ", day_ini
150    
151        call NF95_INQ_VARID (ncid, "rlonu", varid)
152        call NF95_GET_VAR(ncid, varid, rlonu)
153    
154        call NF95_INQ_VARID (ncid, "rlatu", varid)
155        call NF95_GET_VAR(ncid, varid, rlatu)
156    
157        call NF95_INQ_VARID (ncid, "rlonv", varid)
158        call NF95_GET_VAR(ncid, varid, rlonv)
159    
160        call NF95_INQ_VARID (ncid, "rlatv", varid)
161        call NF95_GET_VAR(ncid, varid, rlatv)
162    
163        CALL nf95_inq_varid(ncid, 'xprimu', varid)
164        CALL nf95_get_var(ncid, varid, xprimu)
165    
166        CALL nf95_inq_varid(ncid, 'xprimv', varid)
167        CALL nf95_get_var(ncid, varid, xprimv)
168    
169        CALL nf95_inq_varid(ncid, 'xprimm025', varid)
170        CALL nf95_get_var(ncid, varid, xprimm025)
171    
172        CALL nf95_inq_varid(ncid, 'xprimp025', varid)
173        CALL nf95_get_var(ncid, varid, xprimp025)
174    
175        call NF95_INQ_VARID (ncid, "rlatu1", varid)
176        call NF95_GET_VAR(ncid, varid, rlatu1)
177    
178        call NF95_INQ_VARID (ncid, "rlatu2", varid)
179        call NF95_GET_VAR(ncid, varid, rlatu2)
180    
181        CALL nf95_inq_varid(ncid, 'yprimu1', varid)
182        CALL nf95_get_var(ncid, varid, yprimu1)
183    
184        CALL nf95_inq_varid(ncid, 'yprimu2', varid)
185        CALL nf95_get_var(ncid, varid, yprimu2)
186    
187        call NF95_INQ_VARID (ncid, "phis", varid)
188        call NF95_GET_VAR(ncid, varid, phis)
189    
190      PRINT *, 'rad = ', rad      call NF95_INQ_VARID (ncid, "ucov", varid)
191      PRINT *, 'omeg = ', omeg      call NF95_GET_VAR(ncid, varid, ucov)
192      PRINT *, 'g = ', g  
193      PRINT *, 'cpp = ', cpp      call NF95_INQ_VARID (ncid, "vcov", varid)
194      PRINT *, 'kappa = ', kappa      call NF95_GET_VAR(ncid, varid, vcov)
   
     IF (im /= iim)  THEN  
        PRINT 1, im, iim  
        STOP 1  
     ELSE  IF (jm /= jjm)  THEN  
        PRINT 2, jm, jjm  
        STOP 1  
     ELSE  IF (lllm /= llm)  THEN  
        PRINT 3, lllm, llm  
        STOP 1  
     ENDIF  
195    
196      call NF95_INQ_VARID (nid, "rlonu", nvarid)      call NF95_INQ_VARID (ncid, "teta", varid)
197      ierr = NF90_GET_VAR(nid, nvarid, rlonu)      call NF95_GET_VAR(ncid, varid, teta)
     call handle_err("dynetat0, rlonu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlatu", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlatu)  
     call handle_err("dynetat0, rlatu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlonv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlonv)  
     call handle_err("dynetat0, rlonv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlatv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlatv)  
     call handle_err("dynetat0, rlatv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "cu", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, cu_2d)  
     call handle_err("dynetat0, cu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "cv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, cv_2d)  
     call handle_err("dynetat0, cv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "aire", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, aire_2d)  
     call handle_err("dynetat0, aire", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "phisinit", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, phis)  
     call handle_err("dynetat0, phisinit", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "temps", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, time)  
     call handle_err("dynetat0, temps", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "ucov", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, ucov, count=(/iim + 1, jjm + 1, llm/))  
     call handle_err("dynetat0, ucov", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "vcov", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, vcov, count=(/iim + 1, jjm, llm/))  
     call handle_err("dynetat0, vcov", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "teta", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, teta, count=(/iim + 1, jjm + 1, llm/))  
     call handle_err("dynetat0, teta", ierr, nid)  
198    
199      DO iq = 1, nqmx      DO iq = 1, nqmx
200         call NF95_INQ_VARID(nid, tname(iq), nvarid, ierr)         call NF95_INQ_VARID(ncid, tname(iq), varid, ierr)
201         IF (ierr  /=  NF90_NOERR) THEN         IF (ierr == NF90_NOERR) THEN
202            PRINT *, 'dynetat0: le champ "' // tname(iq) // '" est absent, ' // &            call NF95_GET_VAR(ncid, varid, q(:, :, :, iq))
                "il est donc initialisé ŕ zéro."  
           q(:, :, iq) = 0.  
203         ELSE         ELSE
204            ierr = NF90_GET_VAR(nid, nvarid, q(:, :, iq), &            PRINT *, 'dynetat0: "' // tname(iq) // '" not found, ' // &
205                 count=(/iim + 1, jjm + 1, llm/))                 "setting it to zero..."
206            call handle_err("dynetat0, " // tname(iq), ierr, nid)            q(:, :, :, iq) = 0.
207         ENDIF         ENDIF
208      ENDDO      ENDDO
209    
210      call NF95_INQ_VARID (nid, "masse", nvarid)      call NF95_INQ_VARID (ncid, "masse", varid)
211      ierr = NF90_GET_VAR(nid, nvarid, masse, count=(/iim + 1, jjm + 1, llm/))      call NF95_GET_VAR(ncid, varid, masse)
212      call handle_err("dynetat0, masse", ierr, nid)  
213        call NF95_INQ_VARID (ncid, "ps", varid)
214      call NF95_INQ_VARID (nid, "ps", nvarid)      call NF95_GET_VAR(ncid, varid, ps)
215      ierr = NF90_GET_VAR(nid, nvarid, ps, count=(/iim + 1, jjm + 1/))      ! Check that there is a single value at each pole:
216      call handle_err("dynetat0, ps", ierr, nid)      call assert(ps(1, 1) == ps(2:, 1), "dynetat0 ps north pole")
217        call assert(ps(1, jjm + 1) == ps(2:, jjm + 1), "dynetat0 ps south pole")
218      call NF95_CLOSE(nid)  
219        call NF95_CLOSE(ncid)
     day_ini=day_ini+INT(time)  
     time=time-INT(time)  
   
 1   FORMAT(//10x, 'la valeur de im =', i4, 2x, &  
          'lue sur le fichier de demarrage est differente de la valeur ' &  
          // 'parametree iim =', i4//)  
 2   FORMAT(//10x, 'la valeur de jm =', i4, 2x, &  
          'lue sur le fichier de demarrage est differente de la valeur ' &  
          // 'parametree jjm =', i4//)  
 3   FORMAT(//10x, 'la valeur de lmax =', i4, 2x, &  
          'lue sur le fichier demarrage est differente de la valeur ' &  
          // 'parametree llm =', i4//)  
220    
221    END SUBROUTINE dynetat0    END SUBROUTINE dynetat0
222    
Legend:
Removed from v.9  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21