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