/[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 42 - (hide annotations)
Thu Mar 24 11:52:41 2011 UTC (13 years, 1 month ago) by guez
File size: 4134 byte(s)
Removed programs "test_inter_barxy" and "test_disvert".

Added option "read" for "s_sampling" in "disvert".

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

  ViewVC Help
Powered by ViewVC 1.1.21