| 1 | !------------------------------------------------------------------------ |
|---|
| 2 | ! Copyright 2010, CERFACS, Toulouse, France. |
|---|
| 3 | ! All rights reserved. Use is subject to OASIS3 license terms. |
|---|
| 4 | !============================================================================= |
|---|
| 5 | ! |
|---|
| 6 | ! |
|---|
| 7 | PROGRAM model2 |
|---|
| 8 | ! |
|---|
| 9 | ! Use for netCDF library |
|---|
| 10 | USE netcdf |
|---|
| 11 | ! Use for OASIS communication library |
|---|
| 12 | USE mod_oasis |
|---|
| 13 | ! Use to read the grid, mask, area data |
|---|
| 14 | USE read_all_data |
|---|
| 15 | ! Use for the grid partition |
|---|
| 16 | USE def_parallel_decomposition |
|---|
| 17 | ! |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | ! |
|---|
| 20 | INCLUDE 'mpif.h' |
|---|
| 21 | ! |
|---|
| 22 | INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double |
|---|
| 23 | ! |
|---|
| 24 | CHARACTER(len=30), PARAMETER :: data_gridname='grids.nc' ! file with all the grids |
|---|
| 25 | ! |
|---|
| 26 | ! Component name |
|---|
| 27 | INTEGER, PARAMETER :: mmod = 3 |
|---|
| 28 | CHARACTER(len=7),PARAMETER :: comp_name(mmod) = & |
|---|
| 29 | (/ 'comp2m2', 'comp3m2', 'comp4m2' /) |
|---|
| 30 | INTEGER,PARAMETER :: comp_rmin(mmod) = (/ 0, 2, 5 /) |
|---|
| 31 | INTEGER,PARAMETER :: comp_rmax(mmod) = (/ 1, 4, 5 /) |
|---|
| 32 | INTEGER :: comp_num |
|---|
| 33 | CHARACTER(len=128) :: comp_out ! name of the output log file |
|---|
| 34 | INTEGER :: comp_id ! component identification |
|---|
| 35 | CHARACTER(len=3) :: chout |
|---|
| 36 | ! |
|---|
| 37 | ! Grid parameters definition |
|---|
| 38 | INTEGER, PARAMETER :: mgrid = 2 ! max of grids on a component |
|---|
| 39 | INTEGER :: ngrid ! number of active grids |
|---|
| 40 | INTEGER :: dpes, dpe |
|---|
| 41 | INTEGER :: grid_pmin(mgrid) |
|---|
| 42 | INTEGER :: grid_pmax(mgrid) |
|---|
| 43 | INTEGER :: part_id(mgrid) ! use to connect the partition to the variables |
|---|
| 44 | INTEGER :: nlon(mgrid), nlat(mgrid) ! dimensions in the 2 directions of space |
|---|
| 45 | ! Define 3 grids to be able to reproduce exe2 with 2 comp, comp2 and comp3 with |
|---|
| 46 | ! comp3 defined with 2 sub-components. comp4m2 does not coupled |
|---|
| 47 | CHARACTER(len=4) :: cl_grd_tgt(mgrid) ! name of the grid |
|---|
| 48 | CHARACTER(len=16) :: pname |
|---|
| 49 | ! |
|---|
| 50 | ! Local grid parameters |
|---|
| 51 | INTEGER :: il_extentx(mgrid), il_extenty(mgrid), il_offsetx(mgrid), il_offsety(mgrid) |
|---|
| 52 | INTEGER :: il_size(mgrid), il_offset(mgrid) |
|---|
| 53 | INTEGER :: il_paral_size ! To specify decomposition (APPLE = 3, BOX = 5) |
|---|
| 54 | INTEGER, DIMENSION(:), POINTER :: il_paral ! Decomposition for each proc |
|---|
| 55 | REAL (kind=wp), DIMENSION(:,:), POINTER :: l_lon,l_lat ! lon, lat of the points |
|---|
| 56 | ! |
|---|
| 57 | ! Global rank and pe |
|---|
| 58 | INTEGER :: gmype, gnpes |
|---|
| 59 | |
|---|
| 60 | ! Local rank and pe |
|---|
| 61 | INTEGER :: mype, npes ! rank and number of pe |
|---|
| 62 | INTEGER :: localComm ! local MPI communicator and Initialized |
|---|
| 63 | INTEGER :: icpl |
|---|
| 64 | INTEGER :: subcomm(mgrid) |
|---|
| 65 | ! |
|---|
| 66 | INTEGER :: ierror, w_unit |
|---|
| 67 | INTEGER :: i, j, n, nl, ng, sr |
|---|
| 68 | INTEGER :: FILE_Debug=2 |
|---|
| 69 | ! |
|---|
| 70 | ! Names of exchanged Fields |
|---|
| 71 | ! Used in oasis_def_var and oasis_def_var |
|---|
| 72 | integer, parameter :: mvar = 8 |
|---|
| 73 | integer :: nvar(mgrid) |
|---|
| 74 | character(len=9) :: var_name(mvar,mgrid) |
|---|
| 75 | logical :: var_out(mvar,mgrid) |
|---|
| 76 | integer, parameter :: nlev = 5 |
|---|
| 77 | integer :: var_num(mvar,mgrid) |
|---|
| 78 | ! |
|---|
| 79 | ! Used in oasis_def_var and oasis_def_var |
|---|
| 80 | INTEGER :: var_id(mvar,mgrid) |
|---|
| 81 | INTEGER :: var_nodims(2) |
|---|
| 82 | INTEGER :: var_type |
|---|
| 83 | INTEGER :: var_actual_shape(1) ! not used anymore in OASIS3-MCT |
|---|
| 84 | ! |
|---|
| 85 | REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields |
|---|
| 86 | ! |
|---|
| 87 | INTEGER :: ib |
|---|
| 88 | INTEGER, PARAMETER :: il_nb_time_steps = 6 ! number of time steps |
|---|
| 89 | INTEGER, PARAMETER :: delta_t = 3600 ! time step |
|---|
| 90 | REAL (kind=wp), PARAMETER :: dp_pi=3.14159265359 |
|---|
| 91 | REAL (kind=wp), PARAMETER :: dp_length= 1.2*dp_pi |
|---|
| 92 | ! |
|---|
| 93 | INTEGER :: itap_sec ! Time used in oasis_put/get |
|---|
| 94 | ! |
|---|
| 95 | ! |
|---|
| 96 | ! Exchanged local fields arrays |
|---|
| 97 | ! used in routines oasis_put and oasis_get |
|---|
| 98 | REAL (kind=wp) :: fmin,fmax,fsum |
|---|
| 99 | REAL (kind=wp), POINTER :: field_b(:,:,:) |
|---|
| 100 | REAL (kind=wp), POINTER :: field(:,:) |
|---|
| 101 | ! |
|---|
| 102 | !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 103 | ! INITIALISATION |
|---|
| 104 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 105 | ! |
|---|
| 106 | !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 107 | ! |
|---|
| 108 | call MPI_INIT(ierror) |
|---|
| 109 | IF (ierror /= 0) THEN |
|---|
| 110 | WRITE(*,*) 'mpi_init abort by exec model2' |
|---|
| 111 | CALL oasis_abort(1,'model2','Problem at mpi_init line 109') |
|---|
| 112 | ENDIF |
|---|
| 113 | CALL MPI_Comm_Size ( MPI_COMM_WORLD, gnpes, ierror ) |
|---|
| 114 | IF (ierror /= 0) THEN |
|---|
| 115 | WRITE(*,*) 'MPI_comm_size abort by exec model2' |
|---|
| 116 | CALL oasis_abort(1,'model2','Problem at line 114') |
|---|
| 117 | ENDIF |
|---|
| 118 | CALL MPI_Comm_Rank ( MPI_COMM_WORLD, gmype, ierror ) |
|---|
| 119 | IF (ierror /= 0) THEN |
|---|
| 120 | WRITE(0,*) 'MPI_Comm_Rank abort by exec model2' |
|---|
| 121 | CALL oasis_abort(1,'model2','Problem at line 119') |
|---|
| 122 | ENDIF |
|---|
| 123 | ! |
|---|
| 124 | WRITE(*,*) 'exec model2 gmype ',gmype |
|---|
| 125 | |
|---|
| 126 | ! Define the component as a function of the processes |
|---|
| 127 | comp_num=0 |
|---|
| 128 | do n = 1,mmod |
|---|
| 129 | WRITE(*,*) 'exec model2 n gmype comp_rmin(n)',n,gmype,comp_rmin(n) |
|---|
| 130 | WRITE(*,*) 'exec model2 n gmype comp_rmax(n)',n,gmype,comp_rmax(n) |
|---|
| 131 | if (gmype >= comp_rmin(n) .and. gmype <= comp_rmax(n)) then |
|---|
| 132 | comp_num = n |
|---|
| 133 | WRITE(*,*) 'exec model2 dispatch component on proc gmype ',comp_num,gmype |
|---|
| 134 | endif |
|---|
| 135 | enddo |
|---|
| 136 | ! |
|---|
| 137 | if (comp_num < 1 .or. comp_num > mmod) then |
|---|
| 138 | WRITE(*,*) 'exec model2 abort by comp_num invalid',comp_num,gmype |
|---|
| 139 | CALL oasis_abort(1,'model2','Problem at line 128') |
|---|
| 140 | endif |
|---|
| 141 | ! |
|---|
| 142 | ! comp4m2 and comp2m2 does not couple |
|---|
| 143 | IF ( (comp_num == 3) .or. (comp_num == 1) )THEN |
|---|
| 144 | CALL oasis_init_comp (comp_id, comp_name(comp_num), ierror, coupled=.false. ) |
|---|
| 145 | IF (ierror /= 0) THEN |
|---|
| 146 | WRITE(0,*) 'oasis_init_comp abort by model2 compid ',comp_id |
|---|
| 147 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 137') |
|---|
| 148 | ENDIF |
|---|
| 149 | ELSE |
|---|
| 150 | CALL oasis_init_comp (comp_id, comp_name(comp_num), ierror ) |
|---|
| 151 | IF (ierror /= 0) THEN |
|---|
| 152 | WRITE(0,*) 'oasis_init_comp abort by model2 compid ',comp_id |
|---|
| 153 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 143') |
|---|
| 154 | ENDIF |
|---|
| 155 | ! |
|---|
| 156 | !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 157 | ! |
|---|
| 158 | ! Local communicator with the tasks with the same comp_name name |
|---|
| 159 | CALL oasis_get_localcomm ( localComm, ierror ) |
|---|
| 160 | IF (ierror /= 0) THEN |
|---|
| 161 | WRITE (*,*) 'oasis_get_localcomm abort by model2 compid ',comp_id |
|---|
| 162 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 107') |
|---|
| 163 | ENDIF |
|---|
| 164 | ! |
|---|
| 165 | ! Get MPI local size and rank |
|---|
| 166 | CALL MPI_Comm_Size ( localComm, npes, ierror ) |
|---|
| 167 | IF (ierror /= 0) THEN |
|---|
| 168 | WRITE(*,*) 'MPI_comm_size abort by model2 compid ',comp_id |
|---|
| 169 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 114') |
|---|
| 170 | ENDIF |
|---|
| 171 | ! |
|---|
| 172 | CALL MPI_Comm_Rank ( localComm, mype, ierror ) |
|---|
| 173 | IF (ierror /= 0) THEN |
|---|
| 174 | WRITE (*,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id |
|---|
| 175 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 120') |
|---|
| 176 | ENDIF |
|---|
| 177 | ! |
|---|
| 178 | IF ((FILE_Debug == 1) .AND. (mype == 0)) FILE_Debug=2 |
|---|
| 179 | ! |
|---|
| 180 | IF (FILE_Debug <= 1) THEN |
|---|
| 181 | IF (mype == 0) THEN |
|---|
| 182 | w_unit = 100 + gmype |
|---|
| 183 | WRITE(chout,'(I3)') w_unit |
|---|
| 184 | comp_out=comp_name(comp_num)//'.root_'//chout |
|---|
| 185 | OPEN(w_unit,file=TRIM(comp_out),form='formatted') |
|---|
| 186 | ELSE |
|---|
| 187 | w_unit = 15 |
|---|
| 188 | comp_out=comp_name(comp_num)//'.notroot' |
|---|
| 189 | OPEN(w_unit,file=TRIM(comp_out),form='formatted',position='append') |
|---|
| 190 | ENDIF |
|---|
| 191 | ELSE |
|---|
| 192 | w_unit = 100 + gmype |
|---|
| 193 | WRITE(chout,'(I3)') w_unit |
|---|
| 194 | comp_out=comp_name(comp_num)//'.out_'//chout |
|---|
| 195 | OPEN(w_unit,file=TRIM(comp_out),form='formatted') |
|---|
| 196 | ENDIF |
|---|
| 197 | ! |
|---|
| 198 | IF (FILE_Debug >= 2) THEN |
|---|
| 199 | OPEN(w_unit,file=TRIM(comp_out),form='formatted') |
|---|
| 200 | WRITE (w_unit,*) '-----------------------------------------------------------' |
|---|
| 201 | WRITE (w_unit,*) TRIM(comp_name(comp_num)), ' Running with reals compiled as kind =',wp |
|---|
| 202 | WRITE (w_unit,*) 'I am component ', TRIM(comp_name(comp_num)), ' rank :',gmype |
|---|
| 203 | WRITE (w_unit,*) '----------------------------------------------------------' |
|---|
| 204 | WRITE (w_unit,*) 'I am the', TRIM(comp_name(comp_num)), ' ', 'comp', comp_id, 'local rank', mype |
|---|
| 205 | WRITE (w_unit,*)' localcomm = ',localcomm |
|---|
| 206 | CALL FLUSH(w_unit) |
|---|
| 207 | ENDIF |
|---|
| 208 | ! |
|---|
| 209 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 210 | ! Define coupling field names and whether they are out or in |
|---|
| 211 | ! on each component and each grid |
|---|
| 212 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 213 | subcomm=0 |
|---|
| 214 | ngrid = 2 |
|---|
| 215 | |
|---|
| 216 | ng=1 |
|---|
| 217 | grid_pmin(ng) = 0 |
|---|
| 218 | grid_pmax(ng) = 1 |
|---|
| 219 | icpl = MPI_UNDEFINED |
|---|
| 220 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) icpl = 1 |
|---|
| 221 | call MPI_COMM_SPLIT(localcomm, icpl, 1, subcomm(ng), ierror) |
|---|
| 222 | |
|---|
| 223 | cl_grd_tgt(ng) = "lmdz" ! name of the first grid of comp3 |
|---|
| 224 | |
|---|
| 225 | nvar(ng)=8 |
|---|
| 226 | var_name(1,ng) = 'SC3GR1M21' |
|---|
| 227 | var_out(1,ng) = .true. |
|---|
| 228 | var_num(1,ng) = 1 |
|---|
| 229 | var_name(2,ng) = 'SC3GR1M22' |
|---|
| 230 | var_out(2,ng) = .true. |
|---|
| 231 | var_num(2,ng) = 1 |
|---|
| 232 | var_name(3,ng) = 'SC3GR1M23' |
|---|
| 233 | var_out(3,ng) = .true. |
|---|
| 234 | var_num(3,ng) = 1 |
|---|
| 235 | var_name(4,ng) = 'SC3GR1M2B' |
|---|
| 236 | var_out(4,ng) = .true. |
|---|
| 237 | var_num(4,ng) = 5 |
|---|
| 238 | var_name(5,ng) = 'RC3GR1M21' |
|---|
| 239 | var_out(5,ng) = .false. |
|---|
| 240 | var_num(5,ng) = 1 |
|---|
| 241 | var_name(6,ng) = 'RC3GR1M22' |
|---|
| 242 | var_out(6,ng) = .false. |
|---|
| 243 | var_num(6,ng) = 1 |
|---|
| 244 | var_name(7,ng) = 'RC3GR1M23' |
|---|
| 245 | var_out(7,ng) = .false. |
|---|
| 246 | var_num(7,ng) = 1 |
|---|
| 247 | var_name(8,ng) = 'RC3GR1M2B' |
|---|
| 248 | var_out(8,ng) = .false. |
|---|
| 249 | var_num(8,ng) = 5 |
|---|
| 250 | |
|---|
| 251 | ng=2 |
|---|
| 252 | grid_pmin(ng) = 2 |
|---|
| 253 | grid_pmax(ng) = 2 |
|---|
| 254 | icpl = MPI_UNDEFINED |
|---|
| 255 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) icpl = 1 |
|---|
| 256 | call MPI_COMM_SPLIT(localcomm, icpl, 1, subcomm(ng), ierror) |
|---|
| 257 | |
|---|
| 258 | cl_grd_tgt(ng) = "icos" ! name of the second grid of comp3 |
|---|
| 259 | nvar(ng)=8 |
|---|
| 260 | var_name(1,ng) = 'SC3GR2M21' |
|---|
| 261 | var_out(1,ng) = .true. |
|---|
| 262 | var_num(1,ng) = 1 |
|---|
| 263 | var_name(2,ng) = 'SC3GR2M22' |
|---|
| 264 | var_out(2,ng) = .true. |
|---|
| 265 | var_num(2,ng) = 1 |
|---|
| 266 | var_name(3,ng) = 'SC3GR2M23' |
|---|
| 267 | var_out(3,ng) = .true. |
|---|
| 268 | var_num(3,ng) = 1 |
|---|
| 269 | var_name(4,ng) = 'SC3GR2M2B' |
|---|
| 270 | var_out(4,ng) = .true. |
|---|
| 271 | var_num(4,ng) = 5 |
|---|
| 272 | var_name(5,ng) = 'RC3GR2M21' |
|---|
| 273 | var_out(5,ng) = .false. |
|---|
| 274 | var_num(5,ng) = 1 |
|---|
| 275 | var_name(6,ng) = 'RC3GR2M22' |
|---|
| 276 | var_out(6,ng) = .false. |
|---|
| 277 | var_num(6,ng) = 1 |
|---|
| 278 | var_name(7,ng) = 'RC3GR2M23' |
|---|
| 279 | var_out(7,ng) = .false. |
|---|
| 280 | var_num(7,ng) = 1 |
|---|
| 281 | var_name(8,ng) = 'RC3GR2M2B' |
|---|
| 282 | var_out(8,ng) = .false. |
|---|
| 283 | var_num(8,ng) = 5 |
|---|
| 284 | ! |
|---|
| 285 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 286 | ! GRID DEFINITION |
|---|
| 287 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 288 | ! |
|---|
| 289 | ! Reading global dimensions of the global grid |
|---|
| 290 | |
|---|
| 291 | do ng=1,ngrid |
|---|
| 292 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) then |
|---|
| 293 | CALL read_dimgrid(nlon(ng), nlat(ng), TRIM(data_gridname), TRIM(cl_grd_tgt(ng)), w_unit, FILE_Debug) |
|---|
| 294 | IF (FILE_Debug >= 2) THEN |
|---|
| 295 | write(w_unit,*) ' Comp_num : ',comp_num, ' grid : ',TRIM(cl_grd_tgt(ng)),nlon(ng),nlat(ng) |
|---|
| 296 | endif |
|---|
| 297 | endif |
|---|
| 298 | enddo |
|---|
| 299 | ! |
|---|
| 300 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 301 | ! PARTITION DEFINITION |
|---|
| 302 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 303 | ! |
|---|
| 304 | ! Definition of the local partition |
|---|
| 305 | il_extentx=0 |
|---|
| 306 | il_extenty=0 |
|---|
| 307 | il_size=0 |
|---|
| 308 | il_offsetx=0 |
|---|
| 309 | il_offsety=0 |
|---|
| 310 | il_offset=0 |
|---|
| 311 | ! |
|---|
| 312 | do ng=1,ngrid |
|---|
| 313 | |
|---|
| 314 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) then |
|---|
| 315 | dpe = mype - grid_pmin(ng) |
|---|
| 316 | dpes = grid_pmax(ng)-grid_pmin(ng)+1 |
|---|
| 317 | |
|---|
| 318 | if ( TRIM(cl_grd_tgt(ng)) == 'icos' ) then |
|---|
| 319 | ! APPLE partition |
|---|
| 320 | il_paral_size=3 |
|---|
| 321 | ALLOCATE(il_paral(il_paral_size)) |
|---|
| 322 | il_paral(1)=1 |
|---|
| 323 | il_paral(2)=0 |
|---|
| 324 | il_paral(3)=nlon(ng) |
|---|
| 325 | il_extentx(ng)=il_paral(3) |
|---|
| 326 | il_extenty(ng)=1 |
|---|
| 327 | |
|---|
| 328 | else |
|---|
| 329 | |
|---|
| 330 | call def_local_partition(nlon(ng), nlat(ng), dpes, dpe, & |
|---|
| 331 | il_extentx(ng), il_extenty(ng), & |
|---|
| 332 | il_size(ng), il_offsetx(ng), il_offsety(ng), il_offset(ng)) |
|---|
| 333 | IF (FILE_Debug >= 2) THEN |
|---|
| 334 | WRITE(w_unit,*) 'Local partition definition for grid : ',TRIM(cl_grd_tgt(ng)) |
|---|
| 335 | WRITE(w_unit,*) 'il_extentx, il_extenty, il_size, il_offsetx, il_offsety, il_offset = ', & |
|---|
| 336 | il_extentx(ng), il_extenty(ng), il_size(ng), il_offsetx(ng), & |
|---|
| 337 | il_offsety(ng), il_offset(ng) |
|---|
| 338 | ENDIF |
|---|
| 339 | ! |
|---|
| 340 | call def_paral_size (il_paral_size) |
|---|
| 341 | ALLOCATE(il_paral(il_paral_size)) |
|---|
| 342 | ! |
|---|
| 343 | call def_paral (il_offset(ng), il_size(ng), il_extentx(ng), il_extenty(ng), & |
|---|
| 344 | nlon(ng), il_paral_size, il_paral) |
|---|
| 345 | |
|---|
| 346 | endif |
|---|
| 347 | ! end grid |
|---|
| 348 | |
|---|
| 349 | IF (FILE_Debug >= 2) THEN |
|---|
| 350 | WRITE(w_unit,*) 'il_paral for ', TRIM(cl_grd_tgt(ng)), il_paral(:) |
|---|
| 351 | call flush(w_unit) |
|---|
| 352 | ENDIF |
|---|
| 353 | ! |
|---|
| 354 | write(pname,'(a,i2.2)') cl_grd_tgt(ng),ng |
|---|
| 355 | CALL oasis_def_partition (part_id(ng), il_paral, ierror,name=TRIM(pname)) |
|---|
| 356 | IF (FILE_Debug >= 2) THEN |
|---|
| 357 | WRITE(w_unit,*) 'After oasis_def_partition for grid : ',TRIM(cl_grd_tgt(ng)) |
|---|
| 358 | CALL FLUSH(w_unit) |
|---|
| 359 | ENDIF |
|---|
| 360 | DEALLOCATE(il_paral) |
|---|
| 361 | endif |
|---|
| 362 | ! endif mype, grid_pmin,grid_pmax |
|---|
| 363 | enddo |
|---|
| 364 | ! enddo grids |
|---|
| 365 | ! |
|---|
| 366 | ! |
|---|
| 367 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 368 | ! DEFINITION OF THE LOCAL FIELDS |
|---|
| 369 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 370 | ! |
|---|
| 371 | !!!!!!!!!!!!!!! !!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 372 | ! |
|---|
| 373 | ! Define transient variables |
|---|
| 374 | ! |
|---|
| 375 | var_actual_shape(1) = 1 ! Not used anymore in OASIS3-MCT |
|---|
| 376 | var_type = OASIS_Real |
|---|
| 377 | ! |
|---|
| 378 | ! |
|---|
| 379 | ! Declaration of the field associated with the partition |
|---|
| 380 | do ng=1,ngrid |
|---|
| 381 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) then |
|---|
| 382 | do n = 1,nvar(ng) |
|---|
| 383 | var_nodims(1) = 1 ! Not used anymore |
|---|
| 384 | var_nodims(2) = var_num(n,ng) ! number of bundles |
|---|
| 385 | if (var_out(n,ng)) then |
|---|
| 386 | CALL oasis_def_var (var_id(n,ng),TRIM(var_name(n,ng)), part_id(ng), & |
|---|
| 387 | var_nodims, OASIS_Out, var_actual_shape, var_type, ierror) |
|---|
| 388 | else |
|---|
| 389 | CALL oasis_def_var (var_id(n,ng),TRIM(var_name(n,ng)), part_id(ng), & |
|---|
| 390 | var_nodims, OASIS_In, var_actual_shape, var_type, ierror) |
|---|
| 391 | endif |
|---|
| 392 | IF (ierror /= 0) THEN |
|---|
| 393 | WRITE (w_unit,*) 'oasis_def_var abort by '//trim(comp_name(comp_num))//' compid ',comp_id |
|---|
| 394 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 325') |
|---|
| 395 | ENDIF |
|---|
| 396 | enddo |
|---|
| 397 | endif |
|---|
| 398 | enddo |
|---|
| 399 | ! |
|---|
| 400 | IF (FILE_Debug >= 2) THEN |
|---|
| 401 | WRITE(w_unit,*) 'After oasis_def_var' |
|---|
| 402 | CALL FLUSH(w_unit) |
|---|
| 403 | ENDIF |
|---|
| 404 | ! |
|---|
| 405 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 406 | ! TERMINATION OF DEFINITION PHASE |
|---|
| 407 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 408 | ! All processes involved in the coupling must call oasis_enddef; |
|---|
| 409 | ! here all processes are involved in coupling |
|---|
| 410 | ! |
|---|
| 411 | !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 412 | ! |
|---|
| 413 | CALL oasis_enddef ( ierror ) |
|---|
| 414 | IF (ierror /= 0) THEN |
|---|
| 415 | WRITE (w_unit,*) 'oasis_enddef abort by model2 compid ',comp_id |
|---|
| 416 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 256') |
|---|
| 417 | ENDIF |
|---|
| 418 | ! |
|---|
| 419 | IF (FILE_Debug >= 2) THEN |
|---|
| 420 | WRITE(w_unit,*) 'After oasis_enddef' |
|---|
| 421 | CALL FLUSH(w_unit) |
|---|
| 422 | ENDIF |
|---|
| 423 | ! |
|---|
| 424 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 425 | ! SEND AND RECEIVE ARRAYS |
|---|
| 426 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 427 | !!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!! |
|---|
| 428 | ! |
|---|
| 429 | ! Time loop |
|---|
| 430 | DO ib=1, il_nb_time_steps |
|---|
| 431 | itap_sec = delta_t * (ib-1) ! Time |
|---|
| 432 | |
|---|
| 433 | do sr = 1,2 ! send = 1, recv = 2, to make sure there are no deadlocks |
|---|
| 434 | DO ng=1,ngrid |
|---|
| 435 | if (mype >= grid_pmin(ng) .and. mype <= grid_pmax(ng)) then |
|---|
| 436 | dpe = mype - grid_pmin(ng) |
|---|
| 437 | dpes = grid_pmax(ng)-grid_pmin(ng)+1 |
|---|
| 438 | ! Allocate the local fields sent and received by the components |
|---|
| 439 | ALLOCATE(field_b(il_extentx(ng), il_extenty(ng), nlev), STAT=ierror ) |
|---|
| 440 | IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_recv_b, line 307' |
|---|
| 441 | ALLOCATE(field(il_extentx(ng), il_extenty(ng)), STAT=ierror ) |
|---|
| 442 | IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_recv, line 309' |
|---|
| 443 | ALLOCATE(l_lon(il_extentx(ng), il_extenty(ng)), STAT=ierror ) |
|---|
| 444 | IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating l_lon, line 500' |
|---|
| 445 | ALLOCATE(l_lat(il_extentx(ng), il_extenty(ng)), STAT=ierror ) |
|---|
| 446 | IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating l_lat, line 502' |
|---|
| 447 | |
|---|
| 448 | ! Read local grid longitudes, latitudes to calculate analytical function |
|---|
| 449 | CALL read_grid(nlon(ng), nlat(ng), il_offsetx(ng)+1, il_offsety(ng)+1, & |
|---|
| 450 | il_extentx(ng), il_extenty(ng), & |
|---|
| 451 | TRIM(cl_grd_tgt(ng)), TRIM(data_gridname), w_unit, FILE_Debug, & |
|---|
| 452 | l_lon, l_lat) |
|---|
| 453 | |
|---|
| 454 | |
|---|
| 455 | IF (FILE_Debug >= 2) THEN |
|---|
| 456 | WRITE(w_unit,*) 'After reading grid : ',TRIM(cl_grd_tgt(ng)) |
|---|
| 457 | CALL FLUSH(w_unit) |
|---|
| 458 | ENDIF |
|---|
| 459 | ! |
|---|
| 460 | DO n = 1,nvar(ng) |
|---|
| 461 | ! |
|---|
| 462 | if (var_id(n,ng) /= -1) then |
|---|
| 463 | ! SENT FIEDLS |
|---|
| 464 | if (sr == 1 .and. var_out(n,ng)) then |
|---|
| 465 | ! |
|---|
| 466 | IF (TRIM(var_name(n,ng)) == 'SC3GR1M2B' .OR. & |
|---|
| 467 | TRIM(var_name(n,ng)) == 'SC3GR2M2B') THEN |
|---|
| 468 | ! Send bundle field |
|---|
| 469 | do nl = 1,var_num(n,ng) |
|---|
| 470 | field_b(:,:,nl) = ib*(2.-COS(dp_pi*(ACOS(COS(l_lat(:,:)*dp_pi/180.)* & |
|---|
| 471 | COS(l_lon(:,:)*dp_pi/180.))/dp_length))) |
|---|
| 472 | ! Calculate global min and max on all pes |
|---|
| 473 | if (subcomm(ng) /= MPI_COMM_NULL) CALL flddiag(field_b(:,:,nl),fmin,fmax,fsum,subcomm(ng),il_extentx(ng), il_extenty(ng)) |
|---|
| 474 | if (dpe == 0) WRITE(w_unit,12) 'tcx bundle field sent ',trim(comp_name(comp_num)),TRIM(var_name(n,ng)),TRIM(cl_grd_tgt(ng)) |
|---|
| 475 | if (dpe == 0) WRITE(w_unit,11) 'tcx bundle min max : ',itap_sec,nl,fmin,fmax,fsum |
|---|
| 476 | enddo |
|---|
| 477 | |
|---|
| 478 | CALL oasis_put(var_id(n,ng),itap_sec, field_b, ierror) |
|---|
| 479 | IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Sent) THEN |
|---|
| 480 | WRITE (w_unit,*) 'oasis_put abort by model2 compid ',comp_id |
|---|
| 481 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 305') |
|---|
| 482 | ENDIF |
|---|
| 483 | ! |
|---|
| 484 | ! Send other fields |
|---|
| 485 | ELSE |
|---|
| 486 | field(:,:) = ib*(2.-COS(dp_pi*(ACOS(COS(l_lat(:,:)*dp_pi/180.)* & |
|---|
| 487 | COS(l_lon(:,:)*dp_pi/180.))/dp_length))) |
|---|
| 488 | ! Calculate global min and max on all pes |
|---|
| 489 | if (subcomm(ng) /= MPI_COMM_NULL) CALL flddiag(field(:,:),fmin,fmax,fsum,subcomm(ng),il_extentx(ng), il_extenty(ng)) |
|---|
| 490 | if (dpe == 0) WRITE(w_unit,12) 'tcx other fields sent ',trim(comp_name(comp_num)),TRIM(var_name(n,ng)),TRIM(cl_grd_tgt(ng)) |
|---|
| 491 | if (dpe == 0) WRITE(w_unit,10) 'tcx other fields min max ',itap_sec,fmin,fmax,fsum |
|---|
| 492 | |
|---|
| 493 | CALL oasis_put(var_id(n,ng),itap_sec, field, ierror) |
|---|
| 494 | IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Sent) THEN |
|---|
| 495 | WRITE (w_unit,*) 'oasis_put abort by model2 compid ',comp_id |
|---|
| 496 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 305') |
|---|
| 497 | ENDIF |
|---|
| 498 | |
|---|
| 499 | ENDIF |
|---|
| 500 | |
|---|
| 501 | ! Receive fields |
|---|
| 502 | elseif (sr == 2 .and. .not. var_out(n,ng)) then |
|---|
| 503 | field_b=field_ini |
|---|
| 504 | field=field_ini |
|---|
| 505 | ! |
|---|
| 506 | if (TRIM(var_name(n,ng)) == 'RC3GR1M2B' .OR. & |
|---|
| 507 | TRIM(var_name(n,ng)) == 'RC3GR2M2B') THEN |
|---|
| 508 | |
|---|
| 509 | ! Get bundle fields |
|---|
| 510 | CALL oasis_get(var_id(n,ng),itap_sec, field_b, ierror) |
|---|
| 511 | ! Calculate global min and max on all pes |
|---|
| 512 | do nl = 1,var_num(n,ng) |
|---|
| 513 | if (subcomm(ng) /= MPI_COMM_NULL) CALL flddiag(field_b(:,:,nl),fmin,fmax,fsum,subcomm(ng),il_extentx(ng), il_extenty(ng)) |
|---|
| 514 | if (dpe == 0) WRITE(w_unit,12) 'tcx bundle received ',trim(comp_name(comp_num)),TRIM(var_name(n,ng)),TRIM(cl_grd_tgt(ng)) |
|---|
| 515 | if (dpe == 0) WRITE(w_unit,11) 'tcx bundle min max ',itap_sec,nl,fmin,fmax,fsum |
|---|
| 516 | enddo |
|---|
| 517 | IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Recvd) THEN |
|---|
| 518 | WRITE (w_unit,*) 'oasis_get abort by model2 compid ',comp_id |
|---|
| 519 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 316') |
|---|
| 520 | ENDIF |
|---|
| 521 | ! Get other fields |
|---|
| 522 | else |
|---|
| 523 | CALL oasis_get(var_id(n,ng),itap_sec, field, ierror) |
|---|
| 524 | ! Calculate global min and max on all pes |
|---|
| 525 | if (subcomm(ng) /= MPI_COMM_NULL) CALL flddiag(field(:,:),fmin,fmax,fsum,subcomm(ng),il_extentx(ng), il_extenty(ng)) |
|---|
| 526 | if (dpe == 0) WRITE(w_unit,12) 'tcx other fields received ',trim(comp_name(comp_num)),TRIM(var_name(n,ng)),TRIM(cl_grd_tgt(ng)) |
|---|
| 527 | if (dpe == 0) WRITE(w_unit,10) 'tcx other fields min max ',itap_sec,fmin,fmax,fsum |
|---|
| 528 | IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Recvd) THEN |
|---|
| 529 | WRITE (w_unit,*) 'oasis_get abort by model2 compid ',comp_id |
|---|
| 530 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 316') |
|---|
| 531 | ENDIF |
|---|
| 532 | |
|---|
| 533 | ENDIF |
|---|
| 534 | |
|---|
| 535 | ! endif var_id(n,ng) /= -1 |
|---|
| 536 | endif |
|---|
| 537 | ! End var_out |
|---|
| 538 | endif |
|---|
| 539 | ! Enddo nvar |
|---|
| 540 | ENDDO |
|---|
| 541 | ! endif mype |
|---|
| 542 | endif |
|---|
| 543 | ! Enddo grids |
|---|
| 544 | enddo |
|---|
| 545 | DEALLOCATE(field_b) |
|---|
| 546 | DEALLOCATE(field) |
|---|
| 547 | DEALLOCATE(l_lon) |
|---|
| 548 | DEALLOCATE(l_lat) |
|---|
| 549 | ! enddo sr |
|---|
| 550 | enddo |
|---|
| 551 | ! End time step |
|---|
| 552 | ENDDO |
|---|
| 553 | ! |
|---|
| 554 | IF (FILE_Debug >= 2) THEN |
|---|
| 555 | WRITE (w_unit,*) 'End of the program, after exchanges, before oasis_terminate' |
|---|
| 556 | CALL FLUSH(w_unit) |
|---|
| 557 | ENDIF |
|---|
| 558 | ! |
|---|
| 559 | 10 FORMAT(3X,A,3X,I8,3X,F20.7,3X,F20.7,3X,F20.7) |
|---|
| 560 | 11 FORMAT(3X,A,3X,I8,3X,I3,3X,F20.7,3X,F20.7,3X,F20.7) |
|---|
| 561 | 12 FORMAT(3X,A,3X,A,3X,A,3X,A) |
|---|
| 562 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 563 | ! TERMINATION |
|---|
| 564 | !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
|---|
| 565 | ! |
|---|
| 566 | !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 567 | ! |
|---|
| 568 | ! Collective call to terminate the coupling exchanges |
|---|
| 569 | ! |
|---|
| 570 | CALL oasis_terminate (ierror) |
|---|
| 571 | IF (ierror /= 0) THEN |
|---|
| 572 | WRITE (w_unit,*) 'oasis_terminate abort by model2 compid ',comp_id |
|---|
| 573 | CALL oasis_abort(comp_id,comp_name(comp_num),'Problem at line 340') |
|---|
| 574 | ENDIF |
|---|
| 575 | ! |
|---|
| 576 | ! END condition on comp4m2 |
|---|
| 577 | ENDIF |
|---|
| 578 | CALL MPI_Finalize(ierror) |
|---|
| 579 | ! |
|---|
| 580 | END PROGRAM MODEL2 |
|---|
| 581 | ! |
|---|
