New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
toyatm.F90 in utils/tools/TOYATM/src – NEMO

source: utils/tools/TOYATM/src/toyatm.F90 @ 10619

Last change on this file since 10619 was 10619, checked in by smasson, 5 years ago

trunk: add TOYATM in tools
  • Property svn:executable set to *
File size: 12.6 KB
Line 
1!------------------------------------------------------------------------
2! Copyright 2018/03, CERFACS, Toulouse, France.
3! All rights reserved. Use is subject to OASIS3 license terms.
4!=============================================================================
5!
6PROGRAM TOYATM
7  !
8  USE netcdf
9  USE mod_oasis
10  !
11  IMPLICIT NONE
12  !
13  INTEGER, PARAMETER :: wp = 8
14  !
15  CHARACTER(len=30), PARAMETER   :: data_gridname='grids.nc' ! file with the grids
16  CHARACTER(len=30), PARAMETER   :: data_maskname='masks.nc' ! file with the masks
17  !
18  ! Component name (6 characters) same as in the namcouple
19  CHARACTER(len=6)   :: comp_name = 'toyatm'
20  CHARACTER(len=128) :: comp_out       ! name of the output log file
21  CHARACTER(len=4)   :: cl_grd_src     ! name of the source grid
22  !
23  ! Global grid parameters :
24  INTEGER, PARAMETER :: nlon = 180
25  INTEGER, PARAMETER :: nlat = 90
26
27  REAL (kind=wp)   :: gg_lon(nlon,nlat)
28  REAL (kind=wp)   :: gg_lat(nlon,nlat)
29  INTEGER          :: gg_mask(nlon,nlat)
30  !
31  ! Exchanged local fields arrays
32  REAL (kind=wp), ALLOCATABLE :: field_send(:,:)
33  !
34  REAL (kind=wp), ALLOCATABLE :: field_recv(:,:)
35
36  INTEGER :: mype, npes ! rank and  number of pe
37  INTEGER :: localComm  ! local MPI communicator and Initialized
38  INTEGER :: comp_id    ! component identification
39  !
40  INTEGER :: il_paral(3) ! Decomposition for each proc
41  !
42  INTEGER :: ierror, ios
43  INTEGER, PARAMETER :: w_unit = 711
44  INTEGER :: FILE_Debug=1
45  !
46  ! Names of exchanged Fields
47  CHARACTER(len=8), DIMENSION(3), PARAMETER :: var_name = (/'ATSSTSST','ATSOLFLX','ATFLXEMP'/) ! 8 characters field
48  !
49  ! Used in oasis_def_var and oasis_def_var
50  INTEGER                       :: var_id(3)
51  INTEGER                       :: var_nodims(2) 
52  INTEGER                       :: var_type
53  !
54  INTEGER                       :: niter, time_step, ib, it_sec
55  !
56  ! Grid parameters definition
57  INTEGER                       :: part_id  ! use to connect the partition to the variables
58  INTEGER                       :: var_sh(4) ! local dimensions of the arrays; 2 x rank (=4)
59  INTEGER :: ji, jj
60  INTEGER :: auxfileid, auxdimid(2), auxvarid(2)
61  !
62  ! NEMO namelist parameters
63  INTEGER                       :: numnam_cfg=80, nn_it000, nn_itend
64  INTEGER                       :: nn_stocklist, nn_rstctl, nn_no
65  LOGICAL                       :: ln_rst_list, ln_mskland  , ln_clobber,ln_cfmeta, ln_iscpl, ln_xios_read
66  LOGICAL                       :: ln_rstart, nn_date0, nn_time0, nn_leapy  , nn_istate, nn_stock, nn_write ,nn_chunksz, nn_euler,nn_wxios
67  CHARACTER (len=256)           :: cn_exp , cn_ocerst_in, cn_ocerst_indir, cn_ocerst_out, cn_ocerst_outdir
68  REAL (kind=wp)                :: rn_rdt
69  LOGICAL                       :: ln_linssh, ln_crs, ln_meshmask
70  REAL (kind=wp)                :: rn_isfhmin, rn_atfp
71  !
72  ! NEMO namelists
73!!  NAMELIST/namrun/ nn_it000, nn_itend
74!!  NAMELIST/namdom/ rn_rdt
75      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
76         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
77         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
78         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
79         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
80      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
81  !
82  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
83  !  INITIALISATION
84  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
85  !
86  CALL oasis_init_comp (comp_id, comp_name, ierror )
87  IF (ierror /= 0) THEN
88      WRITE(0,*) 'oasis_init_comp abort by toyatm compid ',comp_id
89      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_init_comp')
90  ENDIF
91  !
92  CALL oasis_get_localcomm ( localComm, ierror )
93  IF (ierror /= 0) THEN
94      WRITE (0,*) 'oasis_get_localcomm abort by toyatm compid ',comp_id
95      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_get_localcomm')
96  ENDIF
97  !
98  ! Get MPI size and rank
99  CALL MPI_Comm_Size ( localComm, npes, ierror )
100  IF (ierror /= 0) THEN
101      WRITE(0,*) 'MPI_comm_size abort by toyatm compid ',comp_id
102      CALL oasis_abort(comp_id,comp_name,'Problem at MPI_Comm_Size')
103  ENDIF
104  !
105  CALL MPI_Comm_Rank ( localComm, mype, ierror )
106  IF (ierror /= 0) THEN
107      WRITE (0,*) 'MPI_Comm_Rank abort by toyatm compid ',comp_id
108      CALL oasis_abort(comp_id,comp_name,'Problem at MPI_Comm_Rank')
109  ENDIF
110  !
111  IF (mype == 0) THEN
112       FILE_Debug = 2
113       comp_out=comp_name//'.root'
114       OPEN(w_unit,file=TRIM(comp_out),form='formatted')
115  ENDIF
116  !
117  IF (FILE_Debug >= 2) THEN
118      WRITE(w_unit,*) '-----------------------------------------------------------'
119      WRITE(w_unit,*) TRIM(comp_name), ' running with reals compiled as kind ',wp
120      WRITE(w_unit,*) '----------------------------------------------------------'
121      WRITE (w_unit,*) 'Number of processors :',npes
122      WRITE(w_unit,*) '----------------------------------------------------------'
123      CALL FLUSH(w_unit)
124  ENDIF
125  !
126  ! Simulation length definition (according to NEMO namelist_cfg)
127  !
128  OPEN (UNIT=numnam_cfg, FILE='namelist_cfg', STATUS='OLD' )
129  READ  ( numnam_cfg, namrun, IOSTAT = ios )
130  REWIND(numnam_cfg)
131  READ  ( numnam_cfg, namdom, IOSTAT = ios )
132  CLOSE(numnam_cfg)
133  !
134! Get time step and number of iterations from ocean
135  time_step = INT(rn_rdt)
136  niter = nn_itend - nn_it000 + 1 
137  !
138  IF (FILE_Debug >= 2) THEN
139      WRITE(w_unit,*) '-----------------------------------------------------------'
140      WRITE (w_unit,*) 'Total time step # :', niter
141      WRITE (w_unit,*) 'Simulation length :', niter*time_step
142      WRITE(w_unit,*) '----------------------------------------------------------'
143      CALL FLUSH(w_unit)
144  ENDIF
145  !
146  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
147  !  GRID DEFINITION
148  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
149  !
150  ! Reading global grids.nc and masks.nc netcdf files
151  ! Get arguments giving source grid acronym and field type
152  !
153  cl_grd_src = 'lmdz'
154  !
155  IF (FILE_Debug >= 2) THEN
156      WRITE(w_unit,*) 'Source grid name : ',cl_grd_src
157      CALL flush(w_unit)
158  ENDIF
159  !
160  !
161  ! Define global grid longitudes, latitudes, mask
162  DO jj = 1, nlat
163     DO ji = 1, nlon
164        gg_lon(ji ,jj) = ( ji - 1 ) * ( 360. / nlon )
165        gg_lat(ji ,jj) = ( jj - 1 ) * ( 180. / nlon )
166     ENDDO
167  ENDDO
168
169  gg_mask(:,:) = 0.
170
171  ! Complete OASIS auxiliary files with yoy grid data
172  !
173  IF (mype == 0) THEN
174     ! Define longitude and latitude
175     CALL check_nf90( nf90_open( data_gridname, nf90_write, auxfileid ) )
176     CALL check_nf90( nf90_redef( auxfileid ) )
177     CALL check_nf90( nf90_def_dim( auxfileid, "toylon", nlon, auxdimid(1)) )
178     CALL check_nf90( nf90_def_dim( auxfileid, "toylat", nlat, auxdimid(2)) )
179     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.lon', NF90_DOUBLE, auxdimid, auxvarid(1)))
180     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.lat', NF90_DOUBLE, auxdimid, auxvarid(2)))
181     CALL check_nf90( nf90_enddef( auxfileid ) )
182     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(1), gg_lon ) )
183     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(2), gg_lat ) )
184     CALL check_nf90( nf90_close( auxfileid ) )
185
186     ! Define mask
187     CALL check_nf90( nf90_open( data_maskname, nf90_write, auxfileid ) )
188     CALL check_nf90( nf90_redef( auxfileid ) )
189     CALL check_nf90( nf90_def_dim( auxfileid, "toylon", nlon, auxdimid(1)) )
190     CALL check_nf90( nf90_def_dim( auxfileid, "toylat", nlat, auxdimid(2)) )
191     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.msk', NF90_INT, auxdimid, auxvarid(1)))
192     CALL check_nf90( nf90_enddef( auxfileid ) )
193     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(1), gg_mask ) )
194     CALL check_nf90( nf90_close( auxfileid ) )
195  ENDIF
196  !
197  IF (FILE_Debug >= 2) THEN
198      WRITE(w_unit,*) 'After grid and mask reading'
199      CALL FLUSH(w_unit)
200  ENDIF
201  !
202  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
203  !  PARTITION DEFINITION
204  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
205  !
206  il_paral(1) = 1  ! Apple decomposition
207  il_paral(2) = mype * nlon * nlat / npes
208  il_paral(3) = nlon * nlat / npes
209  IF ( mype > ( npes - 1 ) ) &
210     il_paral(3) =  nlon * nlat - ( mype * ( nlon * nlat / npes ) )
211  !
212  CALL oasis_def_partition (part_id, il_paral, ierror)
213  !
214  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
215  !  COUPLING LOCAL FIELD DECLARATION 
216  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
217  !
218  var_nodims(1) = 2    ! Rank of the field array is 2
219  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
220  var_type = OASIS_Real
221  !
222  var_sh(1) = 1
223  var_sh(2) = il_paral(3)
224  var_sh(3) = 1 
225  var_sh(4) = 1
226  !
227  ! Declaration of the field associated with the partition (recv)
228  CALL oasis_def_var (var_id(1), var_name(1), part_id, &
229                      var_nodims, OASIS_In, var_sh, var_type, ierror)
230  IF (ierror /= 0) THEN
231      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
232      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
233  ENDIF
234
235  ! Declaration of the field associated with the partition (send)
236  CALL oasis_def_var (var_id(2), var_name(2), part_id, &
237                      var_nodims, OASIS_Out, var_sh, var_type, ierror)
238  IF (ierror /= 0) THEN
239      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
240      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
241  ENDIF
242  CALL oasis_def_var (var_id(3), var_name(3), part_id, &
243                      var_nodims, OASIS_Out, var_sh, var_type, ierror)
244  IF (ierror /= 0) THEN
245      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
246      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
247  ENDIF
248  IF (FILE_Debug >= 2) THEN
249      WRITE(w_unit,*) 'After def_var'
250      CALL FLUSH(w_unit)
251  ENDIF
252  !
253  !
254  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
255  !  TERMINATION OF DEFINITION PHASE
256  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
257  !
258  CALL oasis_enddef ( ierror )
259  IF (ierror /= 0) THEN
260      WRITE(w_unit,*) 'oasis_enddef abort by toyatm compid ',comp_id
261      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_enddef')
262  ENDIF
263  IF (FILE_Debug >= 2) THEN
264      WRITE(w_unit,*) 'After enddef'
265      CALL FLUSH(w_unit)
266  ENDIF
267  !
268  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
269  !  SEND ARRAYS
270  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
271  !
272  ! Allocate the fields send and received by the model1
273  !
274  ALLOCATE(field_send(var_sh(2),var_sh(4)), STAT=ierror )
275  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_send'
276  ALLOCATE(field_recv(var_sh(2),var_sh(4)), STAT=ierror )
277  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_recv'
278  !
279  DO ib=1, niter
280    it_sec = time_step * (ib-1) ! Time
281 
282    ! QNS
283    field_send(:,:) = 1. 
284    !
285    CALL oasis_put(var_id(2), it_sec, field_send, ierror )
286    ! EMPs
287    field_send(:,:) = 10./ 86400.
288    CALL oasis_put(var_id(3), it_sec, field_send, ierror )
289    ! SST
290    CALL oasis_get(var_id(1), it_sec, &
291                   field_recv, &
292                   ierror )
293    !
294  END DO
295  !
296  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
297  !         TERMINATION
298  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
299  IF (FILE_Debug >= 2) THEN
300      WRITE(w_unit,*) 'End of the program, before oasis_terminate'
301      CALL FLUSH(w_unit)
302  ENDIF
303  !
304  CALL oasis_terminate (ierror)
305  IF (ierror /= 0) THEN
306      WRITE(w_unit,*) 'oasis_terminate abort by toyatm compid ',comp_id
307      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_terminate')
308  ENDIF
309  !
310CONTAINS
311
312
313   SUBROUTINE check_nf90(status, errorFlag)
314   !---------------------------------------------------------------------
315   !  Checks return code from nf90 library calls and warns if needed
316   !  If errorFlag is present then it just increments this flag (OMP use)
317   !
318   !---------------------------------------------------------------------
319      INTEGER, INTENT(IN   ) :: status
320      INTEGER, INTENT(INOUT), OPTIONAL :: errorFlag
321   !---------------------------------------------------------------------
322
323      IF( status /= nf90_noerr ) THEN
324         WRITE(w_unit,*) 'ERROR! : '//TRIM(nf90_strerror(status))
325         IF( PRESENT( errorFlag ) ) THEN
326            errorFlag = errorFlag + status
327         ELSE
328            WRITE(w_unit,*) "*** TOYATM failed on netcdf ***"
329            WRITE(w_unit,*)
330            STOP 5
331         ENDIF
332      ENDIF
333
334   END SUBROUTINE check_nf90
335  !
336END PROGRAM TOYATM
337!
Note: See TracBrowser for help on using the repository browser.