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

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

ice restart should work in the nesting tools now. However ocean restart has been broken for some time

  • Property svn:keywords set to Id
File size: 7.9 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, parent_bathy_meter_updated, parent_domcfg_updated, &
64     &               restart_file, restart_trc_file, restart_ice_file
65  CHARACTER*100 ::   dimg_output_file, interp_type
66  !     
67  CHARACTER(len=80) , DIMENSION(20) :: flx_Files, u_files, v_files
68  CHARACTER(len=255), DIMENSION(20) :: VAR_INTERP
69  !
70  NAMELIST /input_output/iom_activated
71  !
72  NAMELIST /coarse_grid_files/parent_coordinate_file, parent_bathy_level, parent_level_name, &
73     &                                                parent_bathy_meter, parent_meter_name, parent_domcfg_out
74  !     
75  NAMELIST /bathymetry/new_topo, elevation_database, elevation_name, smoothing, smoothing_factor,  &
76                       ln_agrif_domain, npt_connect, npt_copy, removeclosedseas, type_bathy_interp, rn_hmin     
77  !     
78  NAMELIST /nesting/nbghostcellsfine, imin, imax, jmin, jmax, rho, rhot, &
79     &              bathy_update, parent_bathy_meter_updated, parent_domcfg_updated     
80  !
81  NAMELIST /vertical_grid/ppkth, ppacr, ppdzmin, pphmax, psur, pa0, pa1, N, ldbletanh, ln_e3_dep, pa2, ppkth2, ppacr2
82  !
83  NAMELIST /partial_cells/partial_steps, e3zps_min, e3zps_rat     
84  !
85  NAMELIST /nemo_coarse_grid/ jpizoom, jpjzoom 
86  !         
87  NAMELIST /forcing_files/ flx_files,  u_files,  v_files 
88  !           
89  NAMELIST /interp/ VAR_INTERP
90  !     
91  NAMELIST /restart/ restart_file, shlat, dimg, dimg_output_file, adatrj, interp_type 
92  !
93  NAMELIST /restart_trc/ restart_trc_file, interp_type 
94  !
95  NAMELIST /restart_ice/ restart_ice_file, interp_type 
96  !
97CONTAINS
98  !
99  !********************************************************
100  !subroutine agrif_grid_allocate            *
101  !                     *
102  !allocation of grid type elements          *
103  !      according to nx and ny           *
104  !                     *
105  !                     *
106  !********************************************************
107  !       
108  SUBROUTINE agrif_grid_allocate(Grid, nx, ny)
109    !
110    TYPE(Coordinates) :: Grid
111    INTEGER :: nx, ny
112    !
113    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
114    !
115    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
116    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
117    !
118    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
119    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
120    !
121    ALLOCATE(Grid%bathy_level(nx,ny))
122    !
123  END SUBROUTINE agrif_grid_allocate
124  !
125  !
126  !************************************************************************
127  !                           *
128  !   subroutine read_namelist                  *
129  !                           *
130  !   read variables contained in namelist.input file          *
131  !   filled in by user                      *
132  !                           *
133  !************************************************************************
134  !
135  SUBROUTINE read_namelist(namelistname)
136    !
137    IMPLICIT NONE
138    CHARACTER(len=80) :: namelistname
139    CHARACTER*255 :: output
140    LOGICAL :: is_it_there
141    INTEGER unit_nml
142    !     
143    FLX_FILES  = ''
144    U_FILES    = ''
145    V_FILES    = ''
146    VAR_INTERP = ''
147    unit_nml = Agrif_Get_Unit()
148    !     
149    INQUIRE ( FILE = namelistname , EXIST = is_it_there )     
150    !
151    IF ( is_it_there ) THEN 
152       !
153       OPEN ( FILE   = namelistname , &
154            UNIT   =  unit_nml        , &
155            STATUS = 'OLD'            , &
156            FORM   = 'FORMATTED'      , &
157            ACTION = 'READ'           , &
158            ACCESS = 'SEQUENTIAL'     )
159       !
160       REWIND(unit_nml)
161       READ (unit_nml , NML = input_output)
162       READ (unit_nml , NML = coarse_grid_files)
163       READ (unit_nml , NML = bathymetry)
164       READ (unit_nml , NML = nesting) 
165       READ (unit_nml , NML = vertical_grid)
166       READ (unit_nml , NML = partial_cells)                   
167       READ (unit_nml , NML = nemo_coarse_grid ) 
168       READ (unit_nml , NML = forcing_files ) 
169       READ (unit_nml , NML = interp )   
170       READ (unit_nml , NML = restart )
171       READ (unit_nml , NML = restart_trc )
172       READ (unit_nml , NML = restart_ice )
173       CLOSE(unit_nml)
174       !
175       irafx = rho
176       irafy = rho
177       imin = imin + jpizoom - 1
178       imax = imax + jpizoom - 1
179       jmin = jmin + jpjzoom - 1
180       jmax = jmax + jpjzoom - 1
181       !
182       IF( ln_agrif_domain ) THEN
183          nxfin = (imax-imin)*irafx+2*nbghostcellsfine+2
184          nyfin = (jmax-jmin)*irafy+2*nbghostcellsfine+2
185       ELSE
186          bathy_update = .FALSE.
187          nbghostcellsfine = 0
188          nxfin = (imax-imin+1)*irafx
189          nyfin = (jmax-jmin+1)*irafy
190       ENDIF
191       !
192    ELSE
193       !
194       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
195       STOP 
196       !
197    END IF
198    !
199    !
200  END SUBROUTINE read_namelist
201
202  INTEGER FUNCTION agrif_int(x)
203
204    REAL :: x
205    INTEGER ::i
206
207    i = FLOOR(x) + 1
208
209    IF( ABS(x - i).LE.0.0001 )THEN
210       agrif_int = i
211    ELSE
212       agrif_int = i-1
213    ENDIF
214
215  END FUNCTION agrif_int
216  !
217  !*************************************************
218  !   function Agrif_Get_Unit                             
219  !*************************************************
220  !
221
222  INTEGER FUNCTION Agrif_Get_Unit()
223    !
224    INTEGER n
225    LOGICAL op
226    INTEGER :: nunit
227    INTEGER :: iii,out,iiimax 
228    !
229    DO n = 7,1000
230       !
231       INQUIRE(Unit=n,Opened=op)
232       !
233       IF (.NOT.op) EXIT
234       !     
235    ENDDO
236    !
237    Agrif_Get_Unit=n
238    !
239    !
240  END FUNCTION Agrif_Get_Unit
241  !
242END MODULE agrif_types
Note: See TracBrowser for help on using the repository browser.