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_CPL_OASIS_ticket2379_2020/TOYATM/src – NEMO

source: utils/tools_CPL_OASIS_ticket2379_2020/TOYATM/src/toyatm.F90 @ 12669

Last change on this file since 12669 was 12669, checked in by clevy, 4 years ago

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