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

Diff of /trunk/Sources/dyn3d/etat0.f

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

revision 27 by guez, Thu Mar 25 14:29:07 2010 UTC revision 43 by guez, Fri Apr 8 12:43:31 2011 UTC
# Line 20  contains Line 20  contains
20      ! This subroutine creates "mask".      ! This subroutine creates "mask".
21    
22      use caldyn0_m, only: caldyn0      use caldyn0_m, only: caldyn0
23      use comconst, only: dtvr, daysec, cpp, kappa, pi      use comconst, only: dtvr, daysec, cpp, kappa
24      use comgeom, only: rlatu, rlonv, rlonu, rlatv, aire_2d, apoln, apols, &      use comgeom, only: rlatu, rlonv, rlonu, rlatv, aire_2d, apoln, apols, &
25           cu_2d, cv_2d           cu_2d, cv_2d
26      use comvert, only: ap, bp, preff, pa      use comvert, only: ap, bp, preff, pa
# Line 31  contains Line 31  contains
31      use dynredem0_m, only: dynredem0      use dynredem0_m, only: dynredem0
32      use dynredem1_m, only: dynredem1      use dynredem1_m, only: dynredem1
33      use exner_hyb_m, only: exner_hyb      use exner_hyb_m, only: exner_hyb
34        USE flincom, only: flinclo, flinopen_nozoom, flininfo
35        use flinget_m, only: flinget
36        use geopot_m, only: geopot
37      use grid_atob, only: grille_m      use grid_atob, only: grille_m
38      use grid_change, only: init_dyn_phy, dyn_phy      use grid_change, only: init_dyn_phy, dyn_phy
39        use histcom, only: histclo
40      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra
41      use iniadvtrac_m, only: iniadvtrac      use iniadvtrac_m, only: iniadvtrac
42      use inidissip_m, only: inidissip      use inidissip_m, only: inidissip
43      use inigeom_m, only: inigeom      use inigeom_m, only: inigeom
44      USE ioipsl, only: flinget, flinclo, flinopen_nozoom, flininfo, histclo      use nr_util, only: pi
45      use paramet_m, only: ip1jm, ip1jmp1      use paramet_m, only: ip1jm, ip1jmp1
46      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
47      use pressure_var, only: pls, p3d      use pressure_var, only: pls, p3d
# Line 46  contains Line 50  contains
50      use regr_pr_o3_m, only: regr_pr_o3      use regr_pr_o3_m, only: regr_pr_o3
51      use serre, only: alphax      use serre, only: alphax
52      USE start_init_orog_m, only: start_init_orog, mask, phis      USE start_init_orog_m, only: start_init_orog, mask, phis
53      use start_init_phys_m, only: qsol_2d      use start_init_phys_m, only: start_init_phys
54      use startdyn, only: start_inter_3d, start_init_dyn      use startdyn, only: start_inter_3d, start_init_dyn
55      use temps, only: itau_phy, annee_ref, day_ref, dt      use temps, only: itau_phy, annee_ref, day_ref
56    
57      ! Variables local to the procedure:      ! Variables local to the procedure:
58    
# Line 79  contains Line 83  contains
83      REAL rugmer(klon)      REAL rugmer(klon)
84      real, dimension(iim + 1, jjm + 1):: relief, zstd_2d, zsig_2d, zgam_2d      real, dimension(iim + 1, jjm + 1):: relief, zstd_2d, zsig_2d, zgam_2d
85      real, dimension(iim + 1, jjm + 1):: zthe_2d, zpic_2d, zval_2d      real, dimension(iim + 1, jjm + 1):: zthe_2d, zpic_2d, zval_2d
86      real, dimension(iim + 1, jjm + 1):: tsol_2d, psol      real, dimension(iim + 1, jjm + 1):: tsol_2d, qsol_2d, psol
87      REAL zmea(klon), zstd(klon)      REAL zmea(klon), zstd(klon)
88      REAL zsig(klon), zgam(klon)      REAL zsig(klon), zgam(klon)
89      REAL zthe(klon)      REAL zthe(klon)
# Line 106  contains Line 110  contains
110      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
111      REAL w(ip1jmp1, llm)      REAL w(ip1jmp1, llm)
112      REAL phystep      REAL phystep
113        real trash
114    
115      !---------------------------------      !---------------------------------
116    
117      print *, "Call sequence information: etat0"      print *, "Call sequence information: etat0"
118    
     ! Construct a grid:  
   
119      dtvr = daysec / real(day_step)      dtvr = daysec / real(day_step)
120      print *, 'dtvr = ', dtvr      print *, 'dtvr = ', dtvr
121    
122        ! Construct a grid:
123    
124      pa = 5e4      pa = 5e4
125      CALL iniconst      CALL iniconst
126      CALL inigeom      CALL inigeom
# Line 137  contains Line 142  contains
142      zmasq = pack(mask, dyn_phy)      zmasq = pack(mask, dyn_phy)
143      PRINT *, 'Masque construit'      PRINT *, 'Masque construit'
144    
145      CALL start_init_dyn(tsol_2d, psol) ! also compute "qsol_2d"      call start_init_phys(tsol_2d, qsol_2d)
146        CALL start_init_dyn(tsol_2d, psol)
147    
148      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
149      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * psol      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * psol
150      CALL exner_hyb(psol, p3d, pks, pk)      CALL exner_hyb(psol, p3d, pks, pk)
151      IF (MINVAL(pk) == MAXVAL(pk)) stop '"pk" should not be constant'      IF (MINVAL(pk) == MAXVAL(pk)) stop '"pk" should not be constant'
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)
155      print *, "maxval(pls(:, :, :)) = ", maxval(pls(:, :, :))      print *, "maxval(pls) = ", maxval(pls)
156    
157      call start_inter_3d('U', rlonv, rlatv, pls, uvent)      call start_inter_3d('U', rlonv, rlatv, pls, uvent)
158      forall (l = 1: llm) uvent(:iim, :, l) = uvent(:iim, :, l) * cu_2d(:iim, :)      forall (l = 1: llm) uvent(:iim, :, l) = uvent(:iim, :, l) * cu_2d(:iim, :)
# Line 157  contains Line 163  contains
163      vvent(iim + 1, :, :) = vvent(1, :, :)      vvent(iim + 1, :, :) = vvent(1, :, :)
164    
165      call start_inter_3d('TEMP', rlonu, rlatv, pls, t3d)      call start_inter_3d('TEMP', rlonu, rlatv, pls, t3d)
166      PRINT *,  'minval(t3d(:, :, :)) = ', minval(t3d(:, :, :))      PRINT *,  'minval(t3d) = ', minval(t3d)
167      print *, "maxval(t3d(:, :, :)) = ", maxval(t3d(:, :, :))      print *, "maxval(t3d) = ", maxval(t3d)
168    
169      tpot(:iim, :, :) = t3d(:iim, :, :) * cpp / pk(:iim, :, :)      tpot(:iim, :, :) = t3d(:iim, :, :) * cpp / pk(:iim, :, :)
170      tpot(iim + 1, :, :) = tpot(1, :, :)      tpot(iim + 1, :, :) = tpot(1, :, :)
# Line 169  contains Line 175  contains
175      ENDDO      ENDDO
176    
177      ! Calcul de l'humidité ŕ saturation :      ! Calcul de l'humidité ŕ 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)
181      IF (MINVAL(qsat) == MAXVAL(qsat)) stop '"qsat" should not be constant'      IF (MINVAL(qsat) == MAXVAL(qsat)) stop '"qsat" should not be constant'
182    
183      ! Water vapor:      ! Water vapor:
# Line 219  contains Line 225  contains
225      ALLOCATE(dlon_lic(iml_lic))      ALLOCATE(dlon_lic(iml_lic))
226      ALLOCATE(dlat_lic(jml_lic))      ALLOCATE(dlat_lic(jml_lic))
227      ALLOCATE(fraclic(iml_lic, jml_lic))      ALLOCATE(fraclic(iml_lic, jml_lic))
228      CALL flinopen_nozoom("landiceref.nc", iml_lic, jml_lic, &      CALL flinopen_nozoom(iml_lic, jml_lic, &
229           llm_tmp, lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt,  &           llm_tmp, lon_lic, lat_lic, lev, ttm_tmp, itaul, date, trash,  &
230           fid)           fid)
231      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp &      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp &
232           , 1, 1, fraclic)           , 1, 1, fraclic)
Legend:
Removed from v.27  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.21