/[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

trunk/dyn3d/etat0.f90 revision 79 by guez, Fri Feb 28 17:52:47 2014 UTC trunk/dyn3d/etat0.f revision 97 by guez, Fri Apr 25 14:58:31 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: cpp, kappa, iniconst      use comconst, only: cpp, kappa, iniconst
# 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
     use pressure_var, only: pls, p3d  
46      use q_sat_m, only: q_sat      use q_sat_m, only: q_sat
47      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
48      use regr_pr_o3_m, only: regr_pr_o3      use regr_pr_o3_m, only: regr_pr_o3
# Line 58  contains Line 57  contains
57    
58      REAL latfi(klon), lonfi(klon)      REAL latfi(klon), lonfi(klon)
59      ! (latitude and longitude of a point of the scalar grid identified      ! (latitude and longitude of a point of the scalar grid identified
60      ! by a simple index, in °)      ! by a simple index, in degrees)
61    
62      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
63      REAL vcov(iim + 1, jjm, llm)      REAL vcov(iim + 1, jjm, llm)
# Line 93  contains Line 92  contains
92      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
93      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)
94    
95      ! Déclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
96      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
97      INTEGER ncid, varid      INTEGER ncid, varid
98      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, pointer:: dlon_lic(:), dlat_lic(:)
# Line 108  contains Line 107  contains
107      REAL masse(iim + 1, jjm + 1, llm)      REAL masse(iim + 1, jjm + 1, llm)
108      REAL phi(iim + 1, jjm + 1, llm)      REAL phi(iim + 1, jjm + 1, llm)
109      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
110      REAL w(ip1jmp1, llm)      REAL w(iim + 1, jjm + 1, llm)
111    
112      real sig1(klon, llm) ! section adiabatic updraft      real sig1(klon, llm) ! section adiabatic updraft
113      real w01(klon, llm) ! vertical velocity within adiabatic updraft      real w01(klon, llm) ! vertical velocity within adiabatic updraft
114    
115        real pls(iim + 1, jjm + 1, llm)
116        ! (pressure at mid-layer of LMDZ grid, in Pa)
117        ! "pls(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
118        ! for layer "l")
119    
120        REAL p3d(iim + 1, jjm + 1, llm+1) ! pressure at layer interfaces, in Pa
121        ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
122        ! for interface "l")
123    
124      !---------------------------------      !---------------------------------
125    
126      print *, "Call sequence information: etat0"      print *, "Call sequence information: etat0"
# Line 148  contains Line 156  contains
156      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
157      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
158      CALL exner_hyb(ps, p3d, pks, pk)      CALL exner_hyb(ps, p3d, pks, pk)
159      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  
160    
161      pls = preff * (pk / cpp)**(1. / kappa)      pls = preff * (pk / cpp)**(1. / kappa)
162      PRINT *, "minval(pls) = ", minval(pls)      PRINT *, "minval(pls) = ", minval(pls)
# Line 177  contains Line 182  contains
182              / apols              / apols
183      ENDDO      ENDDO
184    
185      ! Calcul de l'humidité à saturation :      ! Calcul de l'humidit\'e \`a saturation :
186      qsat = q_sat(t3d, pls)      qsat = q_sat(t3d, pls)
187      PRINT *, "minval(qsat) = ", minval(qsat)      PRINT *, "minval(qsat) = ", minval(qsat)
188      print *, "maxval(qsat) = ", maxval(qsat)      print *, "maxval(qsat) = ", maxval(qsat)
# Line 198  contains Line 203  contains
203      if (nqmx >= 5) then      if (nqmx >= 5) then
204         ! Ozone:         ! Ozone:
205         call regr_lat_time_coefoz         call regr_lat_time_coefoz
206         call regr_pr_o3(q(:, :, :, 5))         call regr_pr_o3(p3d, q(:, :, :, 5))
207         ! Convert from mole fraction to mass fraction:         ! Convert from mole fraction to mass fraction:
208         q(:, :, :, 5) = q(:, :, :, 5) * 48. / 29.         q(:, :, :, 5) = q(:, :, :, 5) * 48. / 29.
209      end if      end if
# Line 238  contains Line 243  contains
243    
244      call nf95_close(ncid)      call nf95_close(ncid)
245    
246      ! Interpolation sur la grille T du modèle :      ! Interpolation sur la grille T du mod\`ele :
247      PRINT *, 'Dimensions de "landiceref.nc"'      PRINT *, 'Dimensions de "landiceref.nc"'
248      print *, "iml_lic = ", iml_lic      print *, "iml_lic = ", iml_lic
249      print *, "jml_lic = ", jml_lic      print *, "jml_lic = ", jml_lic
250    
251      ! Si les coordonnées sont en degrés, on les transforme :      ! Si les coordonn\'ees sont en degr\'es, on les transforme :
252      IF (MAXVAL(dlon_lic) > pi) THEN      IF (MAXVAL(dlon_lic) > pi) THEN
253         dlon_lic = dlon_lic * pi / 180.         dlon_lic = dlon_lic * pi / 180.
254      ENDIF      ENDIF
# Line 260  contains Line 265  contains
265      ! Passage sur la grille physique      ! Passage sur la grille physique
266      pctsrf = 0.      pctsrf = 0.
267      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
268      ! Adéquation avec le maque terre/mer      ! Ad\'equation avec le maque terre/mer
269      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
270      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
271      pctsrf(:, is_ter) = zmasq      pctsrf(:, is_ter) = zmasq
# Line 277  contains Line 282  contains
282         end where         end where
283      end where      end where
284    
285      ! 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
286      ! de mer à 0) :      ! de mer \`a 0) :
287      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
288      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
289    
290      ! Vérification que somme des sous-surfaces vaut 1 :      ! V\'erification que somme des sous-surfaces vaut 1 :
291      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
292      IF (ji /= 0) then      IF (ji /= 0) then
293         PRINT *, 'Problème répartition sous maille pour ', ji, 'points'         PRINT *, 'Bad surface percentages for ', ji, 'points'
294      end IF      end IF
295    
296      ! Calcul intermédiaire :      ! Calcul interm\'ediaire :
297      CALL massdair(p3d, masse)      CALL massdair(p3d, masse)
298    
299      print *, 'ALPHAX = ', alphax      print *, 'ALPHAX = ', alphax
Legend:
Removed from v.79  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.21