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

Diff of /trunk/dyn3d/etat0.f

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

trunk/dyn3d/etat0.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC trunk/dyn3d/etat0.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 15  contains Line 15  contains
15    
16    SUBROUTINE etat0    SUBROUTINE etat0
17    
18      ! From "etat0_netcdf.F", version 1.3 2005/05/25 13:10:09      ! From "etat0_netcdf.F", version 1.3, 2005/05/25 13:10:09
19    
20      use caldyn0_m, only: caldyn0      use caldyn0_m, only: caldyn0
21      use comconst, only: dtvr, daysec, cpp, kappa      use comconst, only: cpp, kappa, iniconst
22      use comgeom, only: rlatu, rlonv, rlonu, rlatv, aire_2d, apoln, apols, &      use comgeom, only: rlatu, rlonv, rlonu, rlatv, aire_2d, apoln, apols, &
23           cu_2d, cv_2d, inigeom           cu_2d, cv_2d, inigeom
24      use conf_gcm_m, only: day_step, iphysiq, dayref, anneeref      use conf_gcm_m, only: dayref, anneeref
25      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
26      use dimphy, only: zmasq      use dimphy, only: zmasq
27      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
28      use disvert_m, only: ap, bp, preff, pa      use disvert_m, only: ap, bp, preff, pa, disvert
29      use dynredem0_m, only: dynredem0      use dynredem0_m, only: dynredem0
30      use dynredem1_m, only: dynredem1      use dynredem1_m, only: dynredem1
31      use exner_hyb_m, only: exner_hyb      use exner_hyb_m, only: exner_hyb
# Line 40  contains Line 40  contains
40      use netcdf, only: nf90_nowrite      use netcdf, only: nf90_nowrite
41      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, &      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, &
42           nf95_inq_varid, nf95_open           nf95_inq_varid, nf95_open
43      use nr_util, only: pi      use nr_util, only: pi, assert
44      use paramet_m, only: ip1jm, ip1jmp1      use paramet_m, only: ip1jm, ip1jmp1
45      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
46      use pressure_var, only: pls, p3d      use pressure_var, only: pls, p3d
# Line 58  contains Line 58  contains
58    
59      REAL latfi(klon), lonfi(klon)      REAL latfi(klon), lonfi(klon)
60      ! (latitude and longitude of a point of the scalar grid identified      ! (latitude and longitude of a point of the scalar grid identified
61      ! by a simple index, in °)      ! by a simple index, in degrees)
62    
63      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
64      REAL vcov(iim + 1, jjm, llm)      REAL vcov(iim + 1, jjm, llm)
# Line 93  contains Line 93  contains
93      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
94      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)
95    
96      ! Déclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
97      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
98      INTEGER ncid, varid      INTEGER ncid, varid
99      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, pointer:: dlon_lic(:), dlat_lic(:)
# Line 108  contains Line 108  contains
108      REAL masse(iim + 1, jjm + 1, llm)      REAL masse(iim + 1, jjm + 1, llm)
109      REAL phi(iim + 1, jjm + 1, llm)      REAL phi(iim + 1, jjm + 1, llm)
110      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
111      REAL w(ip1jmp1, llm)      REAL w(iim + 1, jjm + 1, llm)
     REAL phystep  
112    
113      real sig1(klon, llm) ! section adiabatic updraft      real sig1(klon, llm) ! section adiabatic updraft
114      real w01(klon, llm) ! vertical velocity within adiabatic updraft      real w01(klon, llm) ! vertical velocity within adiabatic updraft
# Line 118  contains Line 117  contains
117    
118      print *, "Call sequence information: etat0"      print *, "Call sequence information: etat0"
119    
120      dtvr = daysec / real(day_step)      CALL iniconst
     print *, 'dtvr = ', dtvr  
121    
122      ! Construct a grid:      ! Construct a grid:
123    
124      pa = 5e4      pa = 5e4
125      CALL iniconst      CALL disvert
126      CALL inigeom      CALL inigeom
127      CALL inifilr      CALL inifilr
128    
# Line 150  contains Line 148  contains
148      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
149      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
150      CALL exner_hyb(ps, p3d, pks, pk)      CALL exner_hyb(ps, p3d, pks, pk)
151      IF (MINVAL(pk) == MAXVAL(pk)) then      call assert(MINVAL(pk) /= MAXVAL(pk), '"pk" should not be constant')
        print *, '"pk" should not be constant'  
        stop 1  
     end IF  
152    
153      pls = preff * (pk / cpp)**(1. / kappa)      pls = preff * (pk / cpp)**(1. / kappa)
154      PRINT *, "minval(pls) = ", minval(pls)      PRINT *, "minval(pls) = ", minval(pls)
# Line 179  contains Line 174  contains
174              / apols              / apols
175      ENDDO      ENDDO
176    
177      ! Calcul de l'humidité à saturation :      ! Calcul de l'humidit\'e \`a saturation :
178      qsat = q_sat(t3d, pls)      qsat = q_sat(t3d, pls)
179      PRINT *, "minval(qsat) = ", minval(qsat)      PRINT *, "minval(qsat) = ", minval(qsat)
180      print *, "maxval(qsat) = ", maxval(qsat)      print *, "maxval(qsat) = ", maxval(qsat)
# Line 240  contains Line 235  contains
235    
236      call nf95_close(ncid)      call nf95_close(ncid)
237    
238      ! Interpolation sur la grille T du modèle :      ! Interpolation sur la grille T du mod\`ele :
239      PRINT *, 'Dimensions de "landiceref.nc"'      PRINT *, 'Dimensions de "landiceref.nc"'
240      print *, "iml_lic = ", iml_lic      print *, "iml_lic = ", iml_lic
241      print *, "jml_lic = ", jml_lic      print *, "jml_lic = ", jml_lic
242    
243      ! Si les coordonnées sont en degrés, on les transforme :      ! Si les coordonn\'ees sont en degr\'es, on les transforme :
244      IF (MAXVAL(dlon_lic) > pi) THEN      IF (MAXVAL(dlon_lic) > pi) THEN
245         dlon_lic = dlon_lic * pi / 180.         dlon_lic = dlon_lic * pi / 180.
246      ENDIF      ENDIF
# Line 262  contains Line 257  contains
257      ! Passage sur la grille physique      ! Passage sur la grille physique
258      pctsrf = 0.      pctsrf = 0.
259      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
260      ! Adéquation avec le maque terre/mer      ! Ad\'equation avec le maque terre/mer
261      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
262      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
263      pctsrf(:, is_ter) = zmasq      pctsrf(:, is_ter) = zmasq
# Line 279  contains Line 274  contains
274         end where         end where
275      end where      end where
276    
277      ! Sous-surface océan et glace de mer (pour démarrer on met glace      ! Sous-surface oc\'ean et glace de mer (pour d\'emarrer on met glace
278      ! de mer à 0) :      ! de mer \`a 0) :
279      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
280      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
281    
282      ! Vérification que somme des sous-surfaces vaut 1 :      ! V\'erification que somme des sous-surfaces vaut 1 :
283      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
284      IF (ji /= 0) then      IF (ji /= 0) then
285         PRINT *, 'Problème répartition sous maille pour ', ji, 'points'         PRINT *, 'Bad surface percentages for ', ji, 'points'
286      end IF      end IF
287    
288      ! Calcul intermédiaire :      ! Calcul interm\'ediaire :
289      CALL massdair(p3d, masse)      CALL massdair(p3d, masse)
290    
291      print *, 'ALPHAX = ', alphax      print *, 'ALPHAX = ', alphax
# Line 313  contains Line 308  contains
308      CALL dynredem0("start.nc", dayref, phis)      CALL dynredem0("start.nc", dayref, phis)
309      CALL dynredem1("start.nc", vcov, ucov, teta, q, masse, ps, itau=0)      CALL dynredem1("start.nc", vcov, ucov, teta, q, masse, ps, itau=0)
310    
     ! Ecriture état initial physique:  
     print *, "iphysiq = ", iphysiq  
     phystep = dtvr * REAL(iphysiq)  
     print *, 'phystep = ', phystep  
   
311      ! Initialisations :      ! Initialisations :
312      tsolsrf(:, is_ter) = tsol      tsolsrf(:, is_ter) = tsol
313      tsolsrf(:, is_lic) = tsol      tsolsrf(:, is_lic) = tsol
Legend:
Removed from v.78  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21