source: utils/tools/NESTING/src/agrif_types.f90 @ 10381

Last change on this file since 10381 was 10381, checked in by clem, 23 months ago

attempt to correct several bugs in the NESTING tools. With this version, domcfg.nc file should be written correctly and the partial steps should be taken into account.

  • Property svn:keywords set to Id
File size: 7.7 KB
Line 
1!************************************************************************
2! Fortran 95 OPA Nesting tools                  *
3!                          *
4!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)   *
5!                          *
6!************************************************************************
7!     
8MODULE agrif_types
9  !
10  PUBLIC
11  !   
12  !*****************************
13  ! Coordinates type definition
14  !*****************************
15  TYPE Coordinates
16     !
17     REAL*8,  DIMENSION(:,:),  POINTER :: nav_lon, nav_lat => NULL()
18     REAL*8,  DIMENSION(:,:),  POINTER :: glamv, glamu, glamt, glamf => NULL()
19     REAL*8,  DIMENSION(:,:),  POINTER :: gphit, gphiu, gphiv, gphif => NULL()
20     REAL*8,  DIMENSION(:,:),  POINTER :: e1t, e1u, e1v, e1f => NULL()
21     REAL*8,  DIMENSION(:,:),  POINTER :: e2t, e2u, e2v, e2f => NULL()
22     REAL*8,  DIMENSION(:,:),  POINTER :: bathy_level => NULL()
23     REAL*8,  DIMENSION(:,:),  POINTER :: bathy_meter => NULL()
24     REAL*8,  DIMENSION(:,:),  POINTER :: wgt => NULL()
25     REAL*8,  DIMENSION(:,:,:),POINTER :: fmask, umask, vmask, tmask => NULL()
26     REAL*8,  DIMENSION(:,:,:),POINTER :: e3t_ps, e3w_ps, gdept_ps, gdepwps => NULL()
27     REAL*8,  DIMENSION(:,:),  POINTER :: gdepw_ps => NULL()
28     REAL*8,  DIMENSION(:),    POINTER :: gdeptht => NULL()
29     INTEGER, DIMENSION(:) ,   POINTER :: time_steps => NULL()
30     !     
31  END TYPE Coordinates
32  !
33  !
34  !
35  CHARACTER*8,DIMENSION(10) :: flxtab = (/'socliot1','socliot2','socliopl', &
36       'socliocl','socliohu','socliowi','soshfldo','sohefldo','sowaflup','sofbt   '/)
37  !
38  !
39  !**************************************************************
40  ! Declaration of various input file variables (namelist.input)
41  !**************************************************************
42  !
43  INTEGER ::   irafx, irafy
44  INTEGER ::   nxfin, nyfin
45  !     
46  INTEGER ::   nbghostcellsfine, imin, jmin, imax, jmax, rho, rhot
47  INTEGER ::   shlat
48  INTEGER ::   N, type_bathy_interp
49  !
50  INTEGER ::   jpizoom, jpjzoom, npt_connect, npt_copy
51  !     
52  REAL*8 ::   rn_hmin
53  REAL*8 ::   ppkth2, ppacr2, ppkth, ppacr, ppdzmin, pphmax, smoothing_factor, e3zps_min, e3zps_rat
54  REAL*8 ::   psur, pa0, pa1, pa2, adatrj
55  !       
56  LOGICAL ::   ldbletanh, ln_e3_dep
57  LOGICAL ::   partial_steps, smoothing, bathy_update
58  LOGICAL ::   new_topo, removeclosedseas, dimg, iom_activated
59  LOGICAL ::   ln_agrif_domain
60  !       
61  CHARACTER*100 ::   parent_bathy_level, parent_level_name, parent_bathy_meter, parent_meter_name, parent_domcfg_out
62  CHARACTER*100 ::   elevation_name, elevation_database
63  CHARACTER*100 ::   parent_coordinate_file, restart_file, parent_bathy_meter_updated, parent_domcfg_updated, restart_trc_file
64  CHARACTER*100 ::   dimg_output_file, interp_type
65  !     
66  CHARACTER(len=80) , DIMENSION(20) :: flx_Files, u_files, v_files
67  CHARACTER(len=255), DIMENSION(20) :: VAR_INTERP
68  !
69  NAMELIST /input_output/iom_activated
70  !
71  NAMELIST /coarse_grid_files/parent_coordinate_file, parent_bathy_level, parent_level_name, &
72     &                                                parent_bathy_meter, parent_meter_name, parent_domcfg_out
73  !     
74  NAMELIST /bathymetry/new_topo, elevation_database, elevation_name, smoothing, smoothing_factor,  &
75                       ln_agrif_domain, npt_connect, npt_copy, removeclosedseas, type_bathy_interp, rn_hmin     
76  !     
77  NAMELIST /nesting/nbghostcellsfine, imin, imax, jmin, jmax, rho, rhot, &
78     &              bathy_update, parent_bathy_meter_updated, parent_domcfg_updated     
79  !
80  NAMELIST /vertical_grid/ppkth, ppacr, ppdzmin, pphmax, psur, pa0, pa1, N, ldbletanh, ln_e3_dep, pa2, ppkth2, ppacr2
81  !
82  NAMELIST /partial_cells/partial_steps, e3zps_min, e3zps_rat     
83  !
84  NAMELIST /nemo_coarse_grid/ jpizoom, jpjzoom 
85  !         
86  NAMELIST /forcing_files/ flx_files,  u_files,  v_files 
87  !           
88  NAMELIST /interp/ VAR_INTERP
89  !     
90  NAMELIST /restart/ restart_file, shlat, dimg, dimg_output_file, adatrj, interp_type 
91
92  NAMELIST /restart_trc/ restart_trc_file, interp_type 
93  !
94CONTAINS
95  !
96  !********************************************************
97  !subroutine agrif_grid_allocate            *
98  !                     *
99  !allocation of grid type elements          *
100  !      according to nx and ny           *
101  !                     *
102  !                     *
103  !********************************************************
104  !       
105  SUBROUTINE agrif_grid_allocate(Grid, nx, ny)
106    !
107    TYPE(Coordinates) :: Grid
108    INTEGER :: nx, ny
109    !
110    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
111    !
112    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
113    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
114    !
115    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
116    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
117    !
118    ALLOCATE(Grid%bathy_level(nx,ny))
119    !
120  END SUBROUTINE agrif_grid_allocate
121  !
122  !
123  !************************************************************************
124  !                           *
125  !   subroutine read_namelist                  *
126  !                           *
127  !   read variables contained in namelist.input file          *
128  !   filled in by user                      *
129  !                           *
130  !************************************************************************
131  !
132  SUBROUTINE read_namelist(namelistname)
133    !
134    IMPLICIT NONE
135    CHARACTER(len=80) :: namelistname
136    CHARACTER*255 :: output
137    LOGICAL :: is_it_there
138    INTEGER unit_nml
139    !     
140    FLX_FILES  = ''
141    U_FILES    = ''
142    V_FILES    = ''
143    VAR_INTERP = ''
144    unit_nml = Agrif_Get_Unit()
145    !     
146    INQUIRE ( FILE = namelistname , EXIST = is_it_there )     
147    !
148    IF ( is_it_there ) THEN 
149       !
150       OPEN ( FILE   = namelistname , &
151            UNIT   =  unit_nml        , &
152            STATUS = 'OLD'            , &
153            FORM   = 'FORMATTED'      , &
154            ACTION = 'READ'           , &
155            ACCESS = 'SEQUENTIAL'     )
156       !
157       REWIND(unit_nml)
158       READ (unit_nml , NML = input_output)
159       READ (unit_nml , NML = coarse_grid_files)
160       READ (unit_nml , NML = bathymetry)
161       READ (unit_nml , NML = nesting) 
162       READ (unit_nml , NML = vertical_grid)
163       READ (unit_nml , NML = partial_cells)                   
164       READ (unit_nml , NML = nemo_coarse_grid ) 
165       READ (unit_nml , NML = forcing_files ) 
166       READ (unit_nml , NML = interp )   
167       READ (unit_nml , NML = restart )
168       READ (unit_nml , NML = restart_trc )
169       CLOSE(unit_nml)
170       !
171       irafx = rho
172       irafy = rho
173       imin = imin + jpizoom - 1
174       imax = imax + jpizoom - 1
175       jmin = jmin + jpjzoom - 1
176       jmax = jmax + jpjzoom - 1
177       !
178       IF( ln_agrif_domain ) THEN
179          nxfin = (imax-imin)*irafx+2*nbghostcellsfine+2
180          nyfin = (jmax-jmin)*irafy+2*nbghostcellsfine+2
181       ELSE
182          bathy_update = .FALSE.
183          nbghostcellsfine = 0
184          nxfin = (imax-imin+1)*irafx
185          nyfin = (jmax-jmin+1)*irafy
186       ENDIF
187       !
188    ELSE
189       !
190       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
191       STOP 
192       !
193    END IF
194    !
195    !
196  END SUBROUTINE read_namelist
197
198  INTEGER FUNCTION agrif_int(x)
199
200    REAL :: x
201    INTEGER ::i
202
203    i = FLOOR(x) + 1
204
205    IF( ABS(x - i).LE.0.0001 )THEN
206       agrif_int = i
207    ELSE
208       agrif_int = i-1
209    ENDIF
210
211  END FUNCTION agrif_int
212  !
213  !*************************************************
214  !   function Agrif_Get_Unit                             
215  !*************************************************
216  !
217
218  INTEGER FUNCTION Agrif_Get_Unit()
219    !
220    INTEGER n
221    LOGICAL op
222    INTEGER :: nunit
223    INTEGER :: iii,out,iiimax 
224    !
225    DO n = 7,1000
226       !
227       INQUIRE(Unit=n,Opened=op)
228       !
229       IF (.NOT.op) EXIT
230       !     
231    ENDDO
232    !
233    Agrif_Get_Unit=n
234    !
235    !
236  END FUNCTION Agrif_Get_Unit
237  !
238END MODULE agrif_types
Note: See TracBrowser for help on using the repository browser.