/[lmdze]/trunk/libf/dyn3d/etat0.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/etat0.f90

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

revision 14 by guez, Fri Jul 25 19:59:34 2008 UTC revision 15 by guez, Fri Aug 1 15:24:12 2008 UTC
# Line 6  module etat0_mod Line 6  module etat0_mod
6    IMPLICIT NONE    IMPLICIT NONE
7    
8    REAL pctsrf(klon, nbsrf)    REAL pctsrf(klon, nbsrf)
9      ! ("pctsrf(i, :)" is the composition of the surface at horizontal
10      !  position "i")
11    
12    private nbsrf, klon    private nbsrf, klon
13    
# Line 15  contains Line 17  contains
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      ! This subroutine creates "masque".      ! This subroutine creates "mask".
21    
22      USE ioipsl, only: flinget, flinclo, flinopen_nozoom, flininfo, histclo      USE ioipsl, only: flinget, flinclo, flinopen_nozoom, flininfo, histclo
23    
24      USE start_init_orog_m, only: start_init_orog, masque, phis      USE start_init_orog_m, only: start_init_orog, mask, phis
25      use start_init_phys_m, only: qsol_2d      use start_init_phys_m, only: qsol_2d
26      use startdyn, only: start_inter_3d, start_init_dyn      use startdyn, only: start_inter_3d, start_init_dyn
27      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
# Line 45  contains Line 47  contains
47      use dynredem0_m, only: dynredem0      use dynredem0_m, only: dynredem0
48      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
49      use regr_pr_o3_m, only: regr_pr_o3      use regr_pr_o3_m, only: regr_pr_o3
50        use phyredem_m, only: phyredem
51    
52      ! Variables local to the procedure:      ! Variables local to the procedure:
53    
# Line 128  contains Line 131  contains
131      lonfi(klon) = 0.      lonfi(klon) = 0.
132    
133      call start_init_orog(relief, zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, &      call start_init_orog(relief, zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, &
134           zval_2d) ! also compute "masque" and "phis"           zval_2d) ! also compute "mask" and "phis"
135      call init_dyn_phy ! define the mask "dyn_phy" for distinct grid points      call init_dyn_phy ! define the mask "dyn_phy" for distinct grid points
136      zmasq = pack(masque, dyn_phy)      zmasq = pack(mask, dyn_phy)
137      PRINT *, 'Masque construit'      PRINT *, 'Masque construit'
138    
139      CALL start_init_dyn(tsol_2d, psol) ! also compute "qsol_2d"      CALL start_init_dyn(tsol_2d, psol) ! also compute "qsol_2d"
140    
141      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
142      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * psol(:, :)      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * psol
143      CALL exner_hyb(psol, p3d, pks, pk)      CALL exner_hyb(psol, p3d, pks, pk)
144      IF (MINVAL(pk) == MAXVAL(pk)) stop '"pk" should not be constant'      IF (MINVAL(pk) == MAXVAL(pk)) stop '"pk" should not be constant'
145    
# Line 227  contains Line 230  contains
230      print *, "jml_lic = ", jml_lic      print *, "jml_lic = ", jml_lic
231    
232      ! Si les coordonnées sont en degrés, on les transforme :      ! Si les coordonnées sont en degrés, on les transforme :
233      IF (MAXVAL( lon_lic(:, :) ) > pi)  THEN      IF (MAXVAL( lon_lic ) > pi)  THEN
234         lon_lic(:, :) = lon_lic(:, :) * pi / 180.         lon_lic = lon_lic * pi / 180.
235      ENDIF      ENDIF
236      IF (maxval( lat_lic(:, :) ) > pi) THEN      IF (maxval( lat_lic ) > pi) THEN
237         lat_lic(:, :) = lat_lic(:, :) * pi/ 180.         lat_lic = lat_lic * pi/ 180.
238      ENDIF      ENDIF
239    
240      dlon_lic = lon_lic(:, 1)      dlon_lic = lon_lic(:, 1)
# Line 242  contains Line 245  contains
245      flic_tmp(iim + 1, :) = flic_tmp(1, :)      flic_tmp(iim + 1, :) = flic_tmp(1, :)
246    
247      ! Passage sur la grille physique      ! Passage sur la grille physique
248      pctsrf(:, :)=0.      pctsrf = 0.
249      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
250      ! Adéquation avec le maque terre/mer      ! Adéquation avec le maque terre/mer
251      WHERE (pctsrf(:, is_lic) < EPSFRA ) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA ) pctsrf(:, is_lic) = 0.
# Line 267  contains Line 270  contains
270      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
271    
272      ! Vérification que somme des sous-surfaces vaut 1:      ! Vérification que somme des sous-surfaces vaut 1:
273      ji = count(abs(sum(pctsrf(:, :), dim = 2) - 1. ) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
274      IF (ji /= 0) PRINT *, 'Problème répartition sous maille pour', ji, 'points'      IF (ji /= 0) then
275           PRINT *, 'Problème répartition sous maille pour ', ji, 'points'
276        end IF
277    
278      ! Calcul intermédiaire:      ! Calcul intermédiaire:
279      CALL massdair(p3d, masse)      CALL massdair(p3d, masse)
# Line 317  contains Line 322  contains
322      albe(:, is_oce) = 0.5      albe(:, is_oce) = 0.5
323      albe(:, is_sic) = 0.6      albe(:, is_sic) = 0.6
324      alblw = albe      alblw = albe
325      evap(:, :) = 0.      evap = 0.
326      qsolsrf(:, is_ter) = 150.      qsolsrf(:, is_ter) = 150.
327      qsolsrf(:, is_lic) = 150.      qsolsrf(:, is_lic) = 150.
328      qsolsrf(:, is_oce) = 150.      qsolsrf(:, is_oce) = 150.
Legend:
Removed from v.14  
changed lines
  Added in v.15
  ViewVC Help
Powered by ViewVC 1.1.21