[532] | 1 | MODULE cpl_oasis3 |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE cpl_oasis *** |
---|
| 4 | !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 |
---|
| 5 | !! special case: NEMO OPA/LIM coupled to ECHAM5 |
---|
| 6 | !!===================================================================== |
---|
| 7 | !! History : |
---|
[1281] | 8 | !! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code |
---|
| 9 | !! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision |
---|
[532] | 10 | !! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing |
---|
| 11 | !! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision |
---|
| 12 | !! " " ! 05-09 (R. Redler) extended to allow for communication over root only |
---|
| 13 | !! " " ! 06-01 (W. Park) modification of physical part |
---|
| 14 | !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange |
---|
| 15 | !!---------------------------------------------------------------------- |
---|
| 16 | #if defined key_oasis3 |
---|
| 17 | !!---------------------------------------------------------------------- |
---|
| 18 | !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 |
---|
| 19 | !!---------------------------------------------------------------------- |
---|
| 20 | !!---------------------------------------------------------------------- |
---|
| 21 | !! cpl_prism_init : initialization of coupled mode communication |
---|
| 22 | !! cpl_prism_define : definition of grid and fields |
---|
[1218] | 23 | !! cpl_prism_snd : snd out fields in coupled mode |
---|
| 24 | !! cpl_prism_rcv : receive fields in coupled mode |
---|
[532] | 25 | !! cpl_prism_finalize : finalize the coupled mode communication |
---|
| 26 | !!---------------------------------------------------------------------- |
---|
[1218] | 27 | USE mod_prism_proto ! OASIS3 prism module |
---|
| 28 | USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning |
---|
| 29 | USE mod_prism_grids_writing ! OASIS3 prism module for writing grid files |
---|
| 30 | USE mod_prism_put_proto ! OASIS3 prism module for snding |
---|
| 31 | USE mod_prism_get_proto ! OASIS3 prism module for receiving |
---|
| 32 | USE mod_prism_grids_writing ! OASIS3 prism module for writing grids |
---|
| 33 | USE par_oce ! ocean parameters |
---|
[532] | 34 | USE dom_oce ! ocean space and time domain |
---|
| 35 | USE in_out_manager ! I/O manager |
---|
[1218] | 36 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
---|
[532] | 37 | IMPLICIT NONE |
---|
[1218] | 38 | PRIVATE |
---|
[532] | 39 | ! |
---|
[1218] | 40 | LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. ! coupled flag |
---|
[1698] | 41 | INTEGER, PUBLIC :: OASIS_Rcv = 1 ! return code if received field |
---|
| 42 | INTEGER, PUBLIC :: OASIS_idle = 0 ! return code if nothing done by oasis |
---|
[1218] | 43 | INTEGER :: ncomp_id ! id returned by prism_init_comp |
---|
| 44 | INTEGER :: nerror ! return error code |
---|
[532] | 45 | |
---|
[1218] | 46 | INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields |
---|
| 47 | |
---|
| 48 | TYPE, PUBLIC :: FLD_CPL ! Type for coupling field information |
---|
| 49 | LOGICAL :: laction ! To be coupled or not |
---|
| 50 | CHARACTER(len = 8) :: clname ! Name of the coupling field |
---|
| 51 | CHARACTER(len = 1) :: clgrid ! Grid type |
---|
| 52 | REAL(wp) :: nsgn ! Control of the sign change |
---|
| 53 | INTEGER :: nid ! Id of the field |
---|
| 54 | END TYPE FLD_CPL |
---|
[532] | 55 | |
---|
[1218] | 56 | TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd ! Coupling fields |
---|
[532] | 57 | |
---|
| 58 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving |
---|
| 59 | |
---|
| 60 | !! Routine accessibility |
---|
| 61 | PUBLIC cpl_prism_init |
---|
| 62 | PUBLIC cpl_prism_define |
---|
[1218] | 63 | PUBLIC cpl_prism_snd |
---|
| 64 | PUBLIC cpl_prism_rcv |
---|
[532] | 65 | PUBLIC cpl_prism_finalize |
---|
| 66 | |
---|
| 67 | !!---------------------------------------------------------------------- |
---|
| 68 | !! OPA 9.0 , LOCEAN-IPSL (2006) |
---|
[1218] | 69 | !! $Header$ |
---|
[532] | 70 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
| 71 | !!---------------------------------------------------------------------- |
---|
| 72 | |
---|
| 73 | CONTAINS |
---|
| 74 | |
---|
[1226] | 75 | SUBROUTINE cpl_prism_init (kl_comm) |
---|
[532] | 76 | |
---|
| 77 | !!------------------------------------------------------------------- |
---|
| 78 | !! *** ROUTINE cpl_prism_init *** |
---|
| 79 | !! |
---|
| 80 | !! ** Purpose : Initialize coupled mode communication for ocean |
---|
| 81 | !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) |
---|
| 82 | !! |
---|
| 83 | !! ** Method : OASIS3 MPI communication |
---|
| 84 | !!-------------------------------------------------------------------- |
---|
[1226] | 85 | INTEGER, INTENT( OUT ) :: kl_comm ! local communicator of the model |
---|
| 86 | !!-------------------------------------------------------------------- |
---|
[1218] | 87 | |
---|
[1579] | 88 | ! WARNING: No write in numout in this routine |
---|
| 89 | !============================================ |
---|
| 90 | |
---|
[532] | 91 | !------------------------------------------------------------------ |
---|
| 92 | ! 1st Initialize the PRISM system for the application |
---|
| 93 | !------------------------------------------------------------------ |
---|
[1218] | 94 | CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) |
---|
| 95 | IF ( nerror /= PRISM_Ok ) & |
---|
| 96 | CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') |
---|
[532] | 97 | |
---|
| 98 | !------------------------------------------------------------------ |
---|
| 99 | ! 3rd Get an MPI communicator for OPA local communication |
---|
| 100 | !------------------------------------------------------------------ |
---|
| 101 | |
---|
[1226] | 102 | CALL prism_get_localcomm_proto ( kl_comm, nerror ) |
---|
[1218] | 103 | IF ( nerror /= PRISM_Ok ) & |
---|
| 104 | CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) |
---|
[532] | 105 | |
---|
| 106 | END SUBROUTINE cpl_prism_init |
---|
| 107 | |
---|
| 108 | |
---|
[1226] | 109 | SUBROUTINE cpl_prism_define (krcv, ksnd) |
---|
[532] | 110 | |
---|
| 111 | !!------------------------------------------------------------------- |
---|
| 112 | !! *** ROUTINE cpl_prism_define *** |
---|
| 113 | !! |
---|
| 114 | !! ** Purpose : Define grid and field information for ocean |
---|
| 115 | !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) |
---|
| 116 | !! |
---|
| 117 | !! ** Method : OASIS3 MPI communication |
---|
| 118 | !!-------------------------------------------------------------------- |
---|
[1226] | 119 | INTEGER, INTENT( IN ) :: krcv, ksnd ! Number of received and sent coupling fields |
---|
| 120 | ! |
---|
[1218] | 121 | INTEGER :: id_part |
---|
[532] | 122 | INTEGER :: paral(5) ! OASIS3 box partition |
---|
[1218] | 123 | INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe |
---|
| 124 | INTEGER :: ji ! local loop indicees |
---|
[532] | 125 | !! |
---|
| 126 | !!-------------------------------------------------------------------- |
---|
[1218] | 127 | |
---|
[532] | 128 | IF(lwp) WRITE(numout,*) |
---|
| 129 | IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case' |
---|
| 130 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' |
---|
| 131 | IF(lwp) WRITE(numout,*) |
---|
| 132 | |
---|
| 133 | ! |
---|
| 134 | ! ... Define the shape for the area that excludes the halo |
---|
| 135 | ! For serial configuration (key_mpp_mpi not being active) |
---|
| 136 | ! nl* is set to the global values 1 and jp*glo. |
---|
| 137 | ! |
---|
[1218] | 138 | ishape(:,1) = (/ 1, nlei-nldi+1 /) |
---|
| 139 | ishape(:,2) = (/ 1, nlej-nldj+1 /) |
---|
[532] | 140 | ! |
---|
| 141 | ! ... Allocate memory for data exchange |
---|
| 142 | ! |
---|
[1218] | 143 | ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) |
---|
| 144 | IF (nerror > 0) THEN |
---|
| 145 | CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') |
---|
[532] | 146 | RETURN |
---|
| 147 | ENDIF |
---|
| 148 | ! |
---|
[1218] | 149 | ! ----------------------------------------------------------------- |
---|
| 150 | ! ... Define the partition |
---|
| 151 | ! ----------------------------------------------------------------- |
---|
| 152 | |
---|
| 153 | paral(1) = 2 ! box partitioning |
---|
| 154 | paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset |
---|
| 155 | paral(3) = nlei-nldi+1 ! local extent in i |
---|
| 156 | paral(4) = nlej-nldj+1 ! local extent in j |
---|
| 157 | paral(5) = jpiglo ! global extent in x |
---|
| 158 | |
---|
| 159 | IF( ln_ctl ) THEN |
---|
| 160 | WRITE(numout,*) ' multiexchg: paral (1:5)', paral |
---|
| 161 | WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj |
---|
| 162 | WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp |
---|
| 163 | WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp |
---|
| 164 | ENDIF |
---|
| 165 | |
---|
| 166 | CALL prism_def_partition_proto ( id_part, paral, nerror ) |
---|
[532] | 167 | ! |
---|
[1218] | 168 | ! ... Announce send variables. |
---|
[532] | 169 | ! |
---|
[1226] | 170 | DO ji = 1, ksnd |
---|
[1218] | 171 | IF ( ssnd(ji)%laction ) THEN |
---|
| 172 | CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/), & |
---|
| 173 | & PRISM_Out , ishape , PRISM_REAL, nerror) |
---|
| 174 | IF ( nerror /= PRISM_Ok ) THEN |
---|
| 175 | WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) |
---|
| 176 | CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') |
---|
[532] | 177 | ENDIF |
---|
[1218] | 178 | ENDIF |
---|
| 179 | END DO |
---|
| 180 | ! |
---|
| 181 | ! ... Announce received variables. |
---|
| 182 | ! |
---|
[1226] | 183 | DO ji = 1, krcv |
---|
[1218] | 184 | IF ( srcv(ji)%laction ) THEN |
---|
| 185 | CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/), & |
---|
| 186 | & PRISM_In , ishape , PRISM_REAL, nerror) |
---|
| 187 | IF ( nerror /= PRISM_Ok ) THEN |
---|
| 188 | WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) |
---|
| 189 | CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') |
---|
[532] | 190 | ENDIF |
---|
[1218] | 191 | ENDIF |
---|
| 192 | END DO |
---|
| 193 | |
---|
[532] | 194 | !------------------------------------------------------------------ |
---|
[1218] | 195 | ! End of definition phase |
---|
[532] | 196 | !------------------------------------------------------------------ |
---|
[1218] | 197 | |
---|
| 198 | CALL prism_enddef_proto(nerror) |
---|
| 199 | IF ( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') |
---|
| 200 | |
---|
[532] | 201 | END SUBROUTINE cpl_prism_define |
---|
[1218] | 202 | |
---|
| 203 | |
---|
| 204 | SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) |
---|
[532] | 205 | |
---|
| 206 | !!--------------------------------------------------------------------- |
---|
[1218] | 207 | !! *** ROUTINE cpl_prism_snd *** |
---|
[532] | 208 | !! |
---|
| 209 | !! ** Purpose : - At each coupling time-step,this routine sends fields |
---|
| 210 | !! like sst or ice cover to the coupler or remote application. |
---|
| 211 | !!---------------------------------------------------------------------- |
---|
| 212 | !! * Arguments |
---|
| 213 | !! |
---|
[1218] | 214 | INTEGER, INTENT( IN ) :: kid ! variable intex in the array |
---|
| 215 | INTEGER, INTENT( OUT ) :: kinfo ! OASIS3 info argument |
---|
| 216 | INTEGER, INTENT( IN ) :: kstep ! ocean time-step in seconds |
---|
| 217 | REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pdata |
---|
[532] | 218 | !! |
---|
| 219 | !! |
---|
| 220 | !!-------------------------------------------------------------------- |
---|
| 221 | ! |
---|
[1218] | 222 | ! snd data to OASIS3 |
---|
[532] | 223 | ! |
---|
[1227] | 224 | CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) |
---|
[1218] | 225 | |
---|
| 226 | IF ( ln_ctl ) THEN |
---|
| 227 | IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & |
---|
| 228 | & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN |
---|
| 229 | WRITE(numout,*) '****************' |
---|
| 230 | WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname |
---|
| 231 | WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid |
---|
| 232 | WRITE(numout,*) 'prism_put_proto: kstep ', kstep |
---|
| 233 | WRITE(numout,*) 'prism_put_proto: info ', kinfo |
---|
| 234 | WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) |
---|
| 235 | WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) |
---|
| 236 | WRITE(numout,*) ' - Sum value is ', SUM(pdata) |
---|
| 237 | WRITE(numout,*) '****************' |
---|
| 238 | ENDIF |
---|
| 239 | ENDIF |
---|
| 240 | END SUBROUTINE cpl_prism_snd |
---|
[532] | 241 | |
---|
| 242 | |
---|
[1218] | 243 | SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) |
---|
[532] | 244 | |
---|
| 245 | !!--------------------------------------------------------------------- |
---|
[1218] | 246 | !! *** ROUTINE cpl_prism_rcv *** |
---|
[532] | 247 | !! |
---|
| 248 | !! ** Purpose : - At each coupling time-step,this routine receives fields |
---|
| 249 | !! like stresses and fluxes from the coupler or remote application. |
---|
| 250 | !!---------------------------------------------------------------------- |
---|
[1218] | 251 | INTEGER, INTENT( IN ) :: kid ! variable intex in the array |
---|
| 252 | INTEGER, INTENT( IN ) :: kstep ! ocean time-step in seconds |
---|
| 253 | REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT ) :: pdata ! IN to keep the value if nothing is done |
---|
| 254 | INTEGER, INTENT( OUT ) :: kinfo ! OASIS3 info argument |
---|
[532] | 255 | !! |
---|
[1218] | 256 | LOGICAL :: llaction |
---|
| 257 | !!-------------------------------------------------------------------- |
---|
[532] | 258 | ! |
---|
[1218] | 259 | ! receive local data from OASIS3 on every process |
---|
| 260 | ! |
---|
| 261 | CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo ) |
---|
[532] | 262 | |
---|
[1218] | 263 | llaction = .false. |
---|
| 264 | IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & |
---|
| 265 | kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. |
---|
[532] | 266 | |
---|
[1218] | 267 | IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid |
---|
[532] | 268 | |
---|
[1218] | 269 | IF ( llaction ) THEN |
---|
[532] | 270 | |
---|
[1698] | 271 | kinfo = OASIS_Rcv |
---|
[1227] | 272 | pdata(nldi:nlei, nldj:nlej) = exfld(:,:) |
---|
[1218] | 273 | |
---|
| 274 | !--- Fill the overlap areas and extra hallows (mpp) |
---|
| 275 | !--- check periodicity conditions (all cases) |
---|
| 276 | CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn ) |
---|
| 277 | |
---|
| 278 | IF ( ln_ctl ) THEN |
---|
[532] | 279 | WRITE(numout,*) '****************' |
---|
[1218] | 280 | WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname |
---|
| 281 | WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid |
---|
| 282 | WRITE(numout,*) 'prism_get_proto: kstep', kstep |
---|
| 283 | WRITE(numout,*) 'prism_get_proto: info ', kinfo |
---|
| 284 | WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) |
---|
| 285 | WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) |
---|
| 286 | WRITE(numout,*) ' - Sum value is ', SUM(pdata) |
---|
[532] | 287 | WRITE(numout,*) '****************' |
---|
| 288 | ENDIF |
---|
[1218] | 289 | |
---|
[1698] | 290 | ELSE |
---|
| 291 | kinfo = OASIS_idle |
---|
[532] | 292 | ENDIF |
---|
| 293 | |
---|
[1218] | 294 | END SUBROUTINE cpl_prism_rcv |
---|
[532] | 295 | |
---|
| 296 | |
---|
| 297 | SUBROUTINE cpl_prism_finalize |
---|
| 298 | |
---|
| 299 | !!--------------------------------------------------------------------- |
---|
| 300 | !! *** ROUTINE cpl_prism_finalize *** |
---|
| 301 | !! |
---|
| 302 | !! ** Purpose : - Finalizes the coupling. If MPI_init has not been |
---|
| 303 | !! called explicitly before cpl_prism_init it will also close |
---|
| 304 | !! MPI communication. |
---|
| 305 | !!---------------------------------------------------------------------- |
---|
| 306 | |
---|
| 307 | DEALLOCATE(exfld) |
---|
[1218] | 308 | CALL prism_terminate_proto ( nerror ) |
---|
[532] | 309 | |
---|
[1218] | 310 | END SUBROUTINE cpl_prism_finalize |
---|
[532] | 311 | |
---|
[1218] | 312 | #else |
---|
[532] | 313 | |
---|
[1218] | 314 | !!---------------------------------------------------------------------- |
---|
| 315 | !! Default case Forced Ocean/Atmosphere |
---|
| 316 | !!---------------------------------------------------------------------- |
---|
| 317 | !! Empty module |
---|
| 318 | !!---------------------------------------------------------------------- |
---|
| 319 | USE in_out_manager ! I/O manager |
---|
| 320 | LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag |
---|
| 321 | PUBLIC cpl_prism_init |
---|
| 322 | PUBLIC cpl_prism_finalize |
---|
[532] | 323 | |
---|
[1218] | 324 | CONTAINS |
---|
[532] | 325 | |
---|
[1226] | 326 | SUBROUTINE cpl_prism_init (kl_comm) |
---|
| 327 | INTEGER, INTENT( OUT ) :: kl_comm ! local communicator of the model |
---|
| 328 | kl_comm = -1 |
---|
[1218] | 329 | WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' |
---|
| 330 | END SUBROUTINE cpl_prism_init |
---|
[532] | 331 | |
---|
[1218] | 332 | SUBROUTINE cpl_prism_finalize |
---|
| 333 | WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' |
---|
[532] | 334 | END SUBROUTINE cpl_prism_finalize |
---|
| 335 | |
---|
| 336 | #endif |
---|
| 337 | |
---|
| 338 | END MODULE cpl_oasis3 |
---|