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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (show annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
File size: 3700 byte(s) 
Split "flincom.f90" into "flinclo.f90", "flinfindcood.f90",
"flininfo.f90" and "flinopen_nozoom.f90", in directory
"IOIPSL/Flincom".

Renamed "etat0_lim" to "ce0l", as in LMDZ.

Split "readsulfate.f" into "readsulfate.f90", "readsulfate_preind.f90"
and "getso4fromfile.f90".

In etat0, renamed variable q3d to q, as in "dynredem1". Replaced calls
to Flicom procedures by calls to NetCDF95.

In leapfrog, added call to writehist.

Extracted ASCII art from "grid_noro" into a file
"grid_noro.txt". Transformed explicit-shape local arrays into
automatic arrays, so that test on values of iim and jjm is no longer
needed. Test on weight:
          IF (weight(ii, jj) /= 0.) THEN
is useless. There is already a test before:
    if (any(weight == 0.)) stop "zero weight in grid_noro"

In "aeropt", replaced duplicated lines with different values of inu by
a loop on inu.

Removed arguments of "conf_phys". Corresponding variables are now
defined in "physiq", in a namelist. In "conf_phys", read a namelist
instead of using getin.
1 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 REAL, ALLOCATABLE, SAVE:: mask(:, :) ! fraction of land (iim + 1, jjm + 1)
9 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 use grid_noro_m, only: grid_noro
20 use indicesol, only: epsfra
21 use netcdf, only: nf90_nowrite
22 use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
23 use nr_util, only: pi
24
25 REAL, intent(out):: relief(:, :) ! (iim + 1, jjm + 1) orographie moyenne
26
27 REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
28 ! (deviation standard de l'orographie sous-maille)
29
30 REAL, intent(out):: zsig_2d(:, :) ! (iim + 1, jjm + 1)
31 ! (pente de l'orographie sous-maille)
32
33 REAL, intent(out):: zgam_2d(:, :) ! (iim + 1, jjm + 1)
34 ! (anisotropie de l'orographie sous maille)
35
36 REAL, intent(out):: zthe_2d(:, :) ! (iim + 1, jjm + 1)
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(:, :) ! (iim + 1, jjm + 1)
41 ! hauteur pics de la SSO
42
43 REAL, intent(out):: zval_2d(:, :) ! (iim + 1, jjm + 1)
44 ! hauteur vallees de la SSO
45
46 ! Local:
47
48 INTEGER iml_rel
49 INTEGER jml_rel
50 INTEGER ncid, varid
51 REAL, pointer:: relief_hi(:, :)
52 REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
53 REAL, pointer:: lon_ini(:), lat_ini(:)
54
55 !-----------------------------------
56
57 print *, "Call sequence information: start_init_orog"
58
59 if (any((/size(relief, 1), size(zstd_2d, 1), size(zsig_2d, 1), &
60 size(zgam_2d, 1), size(zthe_2d, 1), size(zpic_2d, 1), &
61 size(zval_2d, 1)/) /= iim + 1)) stop "start_init_orog size 1"
62 if (any((/size(relief, 2), size(zstd_2d, 2), size(zsig_2d, 2), &
63 size(zgam_2d, 2), size(zthe_2d, 2), size(zpic_2d, 2), &
64 size(zval_2d, 2)/) /= jjm + 1)) stop "start_init_orog size 2"
65
66 print *, 'Reading the high resolution orography...'
67
68 call nf95_open('Relief.nc', nf90_nowrite, ncid)
69
70 call nf95_inq_varid(ncid, "longitude", varid)
71 call nf95_gw_var(ncid, varid, lon_ini)
72 lon_ini = lon_ini * pi / 180. ! convert to rad
73 iml_rel = size(lon_ini)
74
75 call nf95_inq_varid(ncid, "latitude", varid)
76 call nf95_gw_var(ncid, varid, lat_ini)
77 lat_ini = lat_ini * pi / 180. ! convert to rad
78 jml_rel = size(lat_ini)
79
80 call nf95_inq_varid(ncid, "RELIEF", varid)
81 call nf95_gw_var(ncid, varid, relief_hi)
82
83 call nf95_close(ncid)
84
85 ALLOCATE(lon_rad(iml_rel))
86 ALLOCATE(lat_rad(jml_rel))
87
88 CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief_hi , &
89 interbar=.FALSE.)
90 deallocate(lon_ini, lat_ini) ! pointers
91
92 print *, 'Compute all the parameters needed for the gravity wave drag code'
93
94 ! Interpolated fields:
95 ALLOCATE(phis(iim + 1, jjm + 1))
96 ALLOCATE(mask(iim + 1, jjm + 1))
97
98 CALL grid_noro(lon_rad, lat_rad, relief_hi, rlonv, rlatu, phis, relief, &
99 zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
100 deallocate(relief_hi) ! pointer
101
102 phis(iim + 1, :) = phis(1, :)
103 phis(:, :) = phis(:, :) * 9.81
104
105 mask(2:, 1) = mask(1, 1) ! north pole
106 mask(2:, jjm + 1) = mask(1, jjm + 1) ! south pole
107 mask(iim + 1, 2:jjm) = mask(1, 2:jjm) ! Greenwich
108 WHERE (mask < EPSFRA)
109 mask = 0.
110 elsewhere (1. - mask < EPSFRA)
111 mask = 1.
112 endwhere
113
114 END SUBROUTINE start_init_orog
115
116 END MODULE start_init_orog_m
  ViewVC Help
Powered by ViewVC 1.1.21