[10619] | 1 | !------------------------------------------------------------------------ |
---|
| 2 | ! Copyright 2018/03, CERFACS, Toulouse, France. |
---|
| 3 | ! All rights reserved. Use is subject to OASIS3 license terms. |
---|
| 4 | !============================================================================= |
---|
| 5 | ! |
---|
| 6 | PROGRAM 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 |
---|
[12669] | 68 | REAL (kind=wp) :: rn_Dt |
---|
[10619] | 69 | LOGICAL :: ln_linssh, ln_crs, ln_meshmask |
---|
[12669] | 70 | REAL (kind=wp) :: rn_atfp |
---|
[10619] | 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 |
---|
[12669] | 78 | NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask |
---|
[10619] | 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 |
---|
[12669] | 133 | time_step = INT(rn_Dt) |
---|
[10619] | 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 | ! |
---|
| 308 | CONTAINS |
---|
| 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 | ! |
---|
| 334 | END PROGRAM TOYATM |
---|
| 335 | ! |
---|