/[lmdze]/trunk/libf/phylmd/Orography/start_init_orog_m.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/Orography/start_init_orog_m.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 32 - (hide annotations)
Tue Apr 6 17:52:58 2010 UTC (14 years, 1 month ago) by guez
File size: 4058 byte(s) 
Split "stringop.f90" into single-procedure files. Gathered files in directory
"IOIPSL/Stringop".

Split "flincom.f90" into "flincom.f90" and "flinget.f90". Removed
unused procedures from module "flincom". Removed unused argument
"filename" of procedure "flinopen_nozoom".

Removed unused files.

Split "grid_change.f90" into "grid_change.f90" and
"gr_phy_write_3d.f90".

Removed unused procedures from modules "calendar", "ioipslmpp",
"grid_atob", "gath_cpl" and "getincom". Removed unused procedures in
files "ppm3d.f" and "thermcell.f".

Split "mathelp.f90" into "mathelp.f90" and "mathop.f90".

Removed unused variable "dpres" of module "comvert".

Use argument "itau" instead of local variables "iadvtr" and "first" to
control algorithm in procedure "fluxstokenc".

Removed unused arguments of procedure "integrd".

Removed useless computations at the end of procedure "leapfrog".

Merged common block "matrfil" into module "parafilt".
1 guez 3 MODULE start_init_orog_m
2    
3     ! From startvar.F, version 1.4
4     ! 2006/01/27 15:14:22 Fairhead
5    
6     IMPLICIT NONE
7    
8 guez 15 REAL, ALLOCATABLE, SAVE:: mask(:, :) ! fraction of land (iim + 1, jjm + 1)
9 guez 3 REAL, ALLOCATABLE, SAVE:: phis(:, :) ! surface geopotential, in m2 s-2
10    
11     CONTAINS
12    
13     SUBROUTINE start_init_orog(relief, zstd_2d, zsig_2d, zgam_2d, zthe_2d, &
14     zpic_2d, zval_2d)
15    
16 guez 32 USE flincom, only: flininfo, flinopen_nozoom, flinclo
17     use flinget_m, only: flinget
18 guez 3 use conf_dat2d_m, only: conf_dat2d
19     use comgeom, only: rlatu, rlonv
20     use dimens_m, only: iim, jjm
21     use indicesol, only: epsfra
22     use comconst, only: pi
23     use grid_noro_m, only: grid_noro
24    
25     REAL, intent(out):: relief(:, :) ! orographie moyenne
26    
27     REAL, intent(out):: zstd_2d(:, :)
28     ! (deviation standard de l'orographie sous-maille)
29    
30     REAL, intent(out):: zsig_2d(:, :)
31     ! (pente de l'orographie sous-maille)
32    
33     REAL, intent(out):: zgam_2d(:, :)
34     ! (anisotropie de l'orographie sous maille)
35    
36     REAL, intent(out):: zthe_2d(:, :)
37     ! (orientation de l'axe oriente dans la direction de plus grande
38     ! pente de l'orographie sous maille)
39    
40     REAL, intent(out):: zpic_2d(:, :) ! hauteur pics de la SSO
41     REAL, intent(out):: zval_2d(:, :) ! hauteur vallees de la SSO
42    
43     ! Local:
44    
45     INTEGER, SAVE:: iml_rel
46     INTEGER, SAVE:: jml_rel
47     REAL lev(1), date, dt
48     INTEGER itau(1), fid
49     INTEGER llm_tmp, ttm_tmp
50     REAL, ALLOCATABLE:: relief_hi(:, :)
51     REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
52     REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
53     REAL, ALLOCATABLE:: lon_rel(:, :), lat_rel(:, :)
54    
55     CHARACTER(len=120) orogfname
56    
57     !-----------------------------------
58    
59     print *, "Call sequence information: start_init_orog"
60    
61     if (any((/size(relief, 1), size(zstd_2d, 1), size(zsig_2d, 1), &
62     size(zgam_2d, 1), size(zthe_2d, 1), size(zpic_2d, 1), &
63     size(zval_2d, 1)/) /= iim + 1)) stop "start_init_orog size 1"
64     if (any((/size(relief, 2), size(zstd_2d, 2), size(zsig_2d, 2), &
65     size(zgam_2d, 2), size(zthe_2d, 2), size(zpic_2d, 2), &
66     size(zval_2d, 2)/) /= jjm + 1)) stop "start_init_orog size 2"
67    
68     orogfname = 'Relief.nc'
69     print *, 'Reading the high resolution orography'
70    
71     CALL flininfo(orogfname, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
72    
73     ALLOCATE(lat_rel(iml_rel, jml_rel))
74     ALLOCATE(lon_rel(iml_rel, jml_rel))
75     ALLOCATE(relief_hi(iml_rel, jml_rel))
76    
77 guez 32 CALL flinopen_nozoom(iml_rel, jml_rel, llm_tmp, &
78 guez 3 lon_rel, lat_rel, lev, ttm_tmp, itau, date, dt, fid)
79     ! 'RELIEF': high resolution orography
80     CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, &
81     relief_hi)
82     CALL flinclo(fid)
83    
84     ! In case we have a file which is in degrees we do the transformation:
85    
86     ALLOCATE(lon_rad(iml_rel))
87     ALLOCATE(lon_ini(iml_rel))
88    
89     IF (MAXVAL(lon_rel(:, :)) > pi) THEN
90     lon_ini(:) = lon_rel(:, 1) * pi / 180.
91     ELSE
92     lon_ini(:) = lon_rel(:, 1)
93     ENDIF
94    
95     ALLOCATE(lat_rad(jml_rel))
96     ALLOCATE(lat_ini(jml_rel))
97    
98     IF (MAXVAL(lat_rel(:, :)) > pi) THEN
99     lat_ini(:) = lat_rel(1, :) * pi / 180.
100     ELSE
101     lat_ini(:) = lat_rel(1, :)
102     ENDIF
103    
104     CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief_hi , &
105     interbar=.FALSE.)
106    
107     print *, 'Compute all the parameters needed for the gravity wave drag code'
108    
109     ! Allocate the data we need to put in the interpolated fields:
110     ALLOCATE(phis(iim + 1, jjm + 1))
111 guez 15 ALLOCATE(mask(iim + 1, jjm + 1))
112 guez 3
113     CALL grid_noro(lon_rad, lat_rad, relief_hi, rlonv, rlatu, phis, relief, &
114 guez 15 zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
115 guez 3
116     phis(iim + 1, :) = phis(1, :)
117     phis(:, :) = phis(:, :) * 9.81
118    
119 guez 15 mask(2:, 1) = mask(1, 1) ! north pole
120     mask(2:, jjm + 1) = mask(1, jjm + 1) ! south pole
121     mask(iim + 1, 2:jjm) = mask(1, 2:jjm) ! Greenwich
122     WHERE (mask < EPSFRA)
123     mask = 0.
124     elsewhere (1. - mask < EPSFRA)
125     mask = 1.
126 guez 3 endwhere
127    
128     END SUBROUTINE start_init_orog
129    
130     END MODULE start_init_orog_m
  ViewVC Help
Powered by ViewVC 1.1.21