cpl_oasis3.F90 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570
  1. MODULE cpl_oasis3
  2. !!======================================================================
  3. !! *** MODULE cpl_oasis ***
  4. !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
  5. !!=====================================================================
  6. !! History :
  7. !! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code
  8. !! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
  9. !! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing
  10. !! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision
  11. !! " " ! 05-09 (R. Redler) extended to allow for communication over root only
  12. !! " " ! 06-01 (W. Park) modification of physical part
  13. !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange
  14. !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields
  15. !!----------------------------------------------------------------------
  16. !!----------------------------------------------------------------------
  17. !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT
  18. !! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3
  19. !!----------------------------------------------------------------------
  20. !! cpl_init : initialization of coupled mode communication
  21. !! cpl_define : definition of grid and fields
  22. !! cpl_snd : snd out fields in coupled mode
  23. !! cpl_rcv : receive fields in coupled mode
  24. !! cpl_finalize : finalize the coupled mode communication
  25. !!----------------------------------------------------------------------
  26. #if defined key_oasis3
  27. USE mod_oasis ! OASIS3-MCT module
  28. #endif
  29. USE par_oce ! ocean parameters
  30. USE dom_oce ! ocean space and time domain
  31. USE in_out_manager ! I/O manager
  32. USE lbclnk ! ocean lateral boundary conditions (or mpp link)
  33. IMPLICIT NONE
  34. PRIVATE
  35. PUBLIC cpl_init
  36. PUBLIC cpl_define
  37. PUBLIC cpl_snd
  38. PUBLIC cpl_rcv
  39. PUBLIC cpl_freq
  40. PUBLIC cpl_finalize
  41. INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field
  42. INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis
  43. INTEGER :: ncomp_id ! id returned by oasis_init_comp
  44. INTEGER :: nerror ! return error code
  45. #if ! defined key_oasis3
  46. ! OASIS Variables not used. defined only for compilation purpose
  47. INTEGER :: OASIS_Out = -1
  48. INTEGER :: OASIS_REAL = -1
  49. INTEGER :: OASIS_Ok = -1
  50. INTEGER :: OASIS_In = -1
  51. INTEGER :: OASIS_Sent = -1
  52. INTEGER :: OASIS_SentOut = -1
  53. INTEGER :: OASIS_ToRest = -1
  54. INTEGER :: OASIS_ToRestOut = -1
  55. INTEGER :: OASIS_Recvd = -1
  56. INTEGER :: OASIS_RecvOut = -1
  57. INTEGER :: OASIS_FromRest = -1
  58. INTEGER :: OASIS_FromRestOut = -1
  59. #endif
  60. INTEGER :: nrcv ! total number of fields received
  61. INTEGER :: nsnd ! total number of fields sent
  62. INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
  63. INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields
  64. INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
  65. INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
  66. TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information
  67. LOGICAL :: laction ! To be coupled or not
  68. CHARACTER(len = 8) :: clname ! Name of the coupling field
  69. CHARACTER(len = 1) :: clgrid ! Grid type
  70. REAL(wp) :: nsgn ! Control of the sign change
  71. INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models)
  72. INTEGER :: nct ! Number of categories in field
  73. INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received
  74. END TYPE FLD_CPL
  75. TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields
  76. REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
  77. !!----------------------------------------------------------------------
  78. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  79. !! $Id: cpl_oasis3.F90 4990 2014-12-15 16:42:49Z timgraham $
  80. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  81. !!----------------------------------------------------------------------
  82. CONTAINS
  83. SUBROUTINE cpl_init( cd_modname, kl_comm )
  84. !!-------------------------------------------------------------------
  85. !! *** ROUTINE cpl_init ***
  86. !!
  87. !! ** Purpose : Initialize coupled mode communication for ocean
  88. !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
  89. !!
  90. !! ** Method : OASIS3 MPI communication
  91. !!--------------------------------------------------------------------
  92. CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file
  93. INTEGER , INTENT(out) :: kl_comm ! local communicator of the model
  94. !!--------------------------------------------------------------------
  95. ! WARNING: No write in numout in this routine
  96. !============================================
  97. !------------------------------------------------------------------
  98. ! 1st Initialize the OASIS system for the application
  99. !------------------------------------------------------------------
  100. CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
  101. IF ( nerror /= OASIS_Ok ) &
  102. CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
  103. !------------------------------------------------------------------
  104. ! 3rd Get an MPI communicator for OPA local communication
  105. !------------------------------------------------------------------
  106. CALL oasis_get_localcomm ( kl_comm, nerror )
  107. IF ( nerror /= OASIS_Ok ) &
  108. CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
  109. !
  110. END SUBROUTINE cpl_init
  111. SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
  112. !!-------------------------------------------------------------------
  113. !! *** ROUTINE cpl_define ***
  114. !!
  115. !! ** Purpose : Define grid and field information for ocean
  116. !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
  117. !!
  118. !! ** Method : OASIS3 MPI communication
  119. !!--------------------------------------------------------------------
  120. INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields
  121. INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
  122. !
  123. INTEGER :: id_part
  124. INTEGER :: paral(5) ! OASIS3 box partition
  125. INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe
  126. INTEGER :: ji,jc,jm ! local loop indicees
  127. CHARACTER(LEN=64) :: zclname
  128. CHARACTER(LEN=2) :: cli2
  129. !!--------------------------------------------------------------------
  130. IF(lwp) WRITE(numout,*)
  131. IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
  132. IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
  133. IF(lwp) WRITE(numout,*)
  134. ncplmodel = kcplmodel
  135. IF( kcplmodel > nmaxcpl ) THEN
  136. CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
  137. ENDIF
  138. nrcv = krcv
  139. IF( nrcv > nmaxfld ) THEN
  140. CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
  141. ENDIF
  142. nsnd = ksnd
  143. IF( nsnd > nmaxfld ) THEN
  144. CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
  145. ENDIF
  146. !
  147. ! ... Define the shape for the area that excludes the halo
  148. ! For serial configuration (key_mpp_mpi not being active)
  149. ! nl* is set to the global values 1 and jp*glo.
  150. !
  151. ishape(:,1) = (/ 1, nlei-nldi+1 /)
  152. ishape(:,2) = (/ 1, nlej-nldj+1 /)
  153. !
  154. ! ... Allocate memory for data exchange
  155. !
  156. ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
  157. IF( nerror > 0 ) THEN
  158. CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN
  159. ENDIF
  160. !
  161. ! -----------------------------------------------------------------
  162. ! ... Define the partition
  163. ! -----------------------------------------------------------------
  164. paral(1) = 2 ! box partitioning
  165. paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset
  166. paral(3) = nlei-nldi+1 ! local extent in i
  167. paral(4) = nlej-nldj+1 ! local extent in j
  168. paral(5) = jpiglo ! global extent in x
  169. IF( ln_ctl ) THEN
  170. WRITE(numout,*) ' multiexchg: paral (1:5)', paral
  171. WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
  172. WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
  173. WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
  174. ENDIF
  175. CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo )
  176. !
  177. ! ... Announce send variables.
  178. !
  179. ssnd(:)%ncplmodel = kcplmodel
  180. !
  181. DO ji = 1, ksnd
  182. IF ( ssnd(ji)%laction ) THEN
  183. IF( ssnd(ji)%nct > nmaxcat ) THEN
  184. CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
  185. & TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
  186. RETURN
  187. ENDIF
  188. DO jc = 1, ssnd(ji)%nct
  189. DO jm = 1, kcplmodel
  190. IF ( ssnd(ji)%nct .GT. 1 ) THEN
  191. WRITE(zclname,'(A,".C",I3.3)') TRIM(ssnd(ji)%clname),jc
  192. ELSE
  193. zclname = ssnd(ji)%clname
  194. ENDIF
  195. IF ( kcplmodel > 1 ) THEN
  196. WRITE(cli2,'(i2.2)') jm
  197. zclname = 'model'//cli2//'_'//TRIM(zclname)
  198. ENDIF
  199. #if defined key_agrif
  200. IF( agrif_fixed() /= 0 ) THEN
  201. zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
  202. END IF
  203. #endif
  204. IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
  205. CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
  206. & OASIS_Out , ishape , OASIS_REAL, nerror )
  207. IF ( nerror /= OASIS_Ok ) THEN
  208. WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
  209. CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
  210. ENDIF
  211. IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
  212. IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
  213. END DO
  214. END DO
  215. ENDIF
  216. END DO
  217. !
  218. ! ... Announce received variables.
  219. !
  220. srcv(:)%ncplmodel = kcplmodel
  221. !
  222. DO ji = 1, krcv
  223. IF ( srcv(ji)%laction ) THEN
  224. IF( srcv(ji)%nct > nmaxcat ) THEN
  225. CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
  226. & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
  227. RETURN
  228. ENDIF
  229. DO jc = 1, srcv(ji)%nct
  230. DO jm = 1, kcplmodel
  231. IF ( srcv(ji)%nct .GT. 1 ) THEN
  232. WRITE(zclname,'(A,".C",I3.3)') TRIM(srcv(ji)%clname),jc
  233. ELSE
  234. zclname = srcv(ji)%clname
  235. ENDIF
  236. IF ( kcplmodel > 1 ) THEN
  237. WRITE(cli2,'(i2.2)') jm
  238. zclname = 'model'//cli2//'_'//TRIM(zclname)
  239. ENDIF
  240. #if defined key_agrif
  241. IF( agrif_fixed() /= 0 ) THEN
  242. zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
  243. END IF
  244. #endif
  245. IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
  246. CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
  247. & OASIS_In , ishape , OASIS_REAL, nerror )
  248. IF ( nerror /= OASIS_Ok ) THEN
  249. WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
  250. CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
  251. ENDIF
  252. IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
  253. IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
  254. END DO
  255. END DO
  256. ENDIF
  257. END DO
  258. !------------------------------------------------------------------
  259. ! End of definition phase
  260. !------------------------------------------------------------------
  261. CALL oasis_enddef(nerror)
  262. IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
  263. !
  264. END SUBROUTINE cpl_define
  265. SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
  266. !!---------------------------------------------------------------------
  267. !! *** ROUTINE cpl_snd ***
  268. !!
  269. !! ** Purpose : - At each coupling time-step,this routine sends fields
  270. !! like sst or ice cover to the coupler or remote application.
  271. !!----------------------------------------------------------------------
  272. INTEGER , INTENT(in ) :: kid ! variable index in the array
  273. INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
  274. INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
  275. REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata
  276. !!
  277. INTEGER :: jc,jm ! local loop index
  278. !!--------------------------------------------------------------------
  279. !
  280. ! snd data to OASIS3
  281. !
  282. DO jc = 1, ssnd(kid)%nct
  283. DO jm = 1, ssnd(kid)%ncplmodel
  284. IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
  285. CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
  286. IF ( ln_ctl ) THEN
  287. IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. &
  288. & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN
  289. WRITE(numout,*) '****************'
  290. WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
  291. WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
  292. WRITE(numout,*) 'oasis_put: kstep ', kstep
  293. WRITE(numout,*) 'oasis_put: info ', kinfo
  294. WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
  295. WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
  296. WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
  297. WRITE(numout,*) '****************'
  298. ENDIF
  299. ENDIF
  300. ENDIF
  301. ENDDO
  302. ENDDO
  303. !
  304. END SUBROUTINE cpl_snd
  305. SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
  306. !!---------------------------------------------------------------------
  307. !! *** ROUTINE cpl_rcv ***
  308. !!
  309. !! ** Purpose : - At each coupling time-step,this routine receives fields
  310. !! like stresses and fluxes from the coupler or remote application.
  311. !!----------------------------------------------------------------------
  312. INTEGER , INTENT(in ) :: kid ! variable index in the array
  313. INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
  314. REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done
  315. REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask
  316. INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
  317. !!
  318. INTEGER :: jc,jm ! local loop index
  319. LOGICAL :: llaction, llfisrt
  320. !!--------------------------------------------------------------------
  321. !
  322. ! receive local data from OASIS3 on every process
  323. !
  324. kinfo = OASIS_idle
  325. !
  326. DO jc = 1, srcv(kid)%nct
  327. llfisrt = .TRUE.
  328. DO jm = 1, srcv(kid)%ncplmodel
  329. IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
  330. CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )
  331. llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &
  332. & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
  333. IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
  334. IF ( llaction ) THEN
  335. kinfo = OASIS_Rcv
  336. IF( llfisrt ) THEN
  337. pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
  338. llfisrt = .FALSE.
  339. ELSE
  340. pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
  341. ENDIF
  342. IF ( ln_ctl ) THEN
  343. WRITE(numout,*) '****************'
  344. WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
  345. WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm)
  346. WRITE(numout,*) 'oasis_get: kstep', kstep
  347. WRITE(numout,*) 'oasis_get: info ', kinfo
  348. WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
  349. WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
  350. WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
  351. WRITE(numout,*) '****************'
  352. ENDIF
  353. ENDIF
  354. ENDIF
  355. ENDDO
  356. !--- Fill the overlap areas and extra hallows (mpp)
  357. !--- check periodicity conditions (all cases)
  358. IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
  359. ENDDO
  360. !
  361. END SUBROUTINE cpl_rcv
  362. INTEGER FUNCTION cpl_freq( cdfieldname )
  363. !!---------------------------------------------------------------------
  364. !! *** ROUTINE cpl_freq ***
  365. !!
  366. !! ** Purpose : - send back the coupling frequency for a particular field
  367. !!----------------------------------------------------------------------
  368. CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file
  369. !!
  370. INTEGER :: id
  371. INTEGER :: info
  372. INTEGER, DIMENSION(1) :: itmp
  373. INTEGER :: ji,jm ! local loop index
  374. INTEGER :: mop
  375. !!----------------------------------------------------------------------
  376. cpl_freq = 0 ! defaut definition
  377. id = -1 ! defaut definition
  378. !
  379. DO ji = 1, nsnd
  380. IF (ssnd(ji)%laction ) THEN
  381. DO jm = 1, ncplmodel
  382. IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
  383. IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
  384. id = ssnd(ji)%nid(1,jm)
  385. mop = OASIS_Out
  386. ENDIF
  387. ENDIF
  388. ENDDO
  389. ENDIF
  390. ENDDO
  391. DO ji = 1, nrcv
  392. IF (srcv(ji)%laction ) THEN
  393. DO jm = 1, ncplmodel
  394. IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
  395. IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
  396. id = srcv(ji)%nid(1,jm)
  397. mop = OASIS_In
  398. ENDIF
  399. ENDIF
  400. ENDDO
  401. ENDIF
  402. ENDDO
  403. !
  404. IF( id /= -1 ) THEN
  405. #if defined key_oa3mct_v3
  406. CALL oasis_get_freqs(id, mop, 1, itmp, info)
  407. #else
  408. CALL oasis_get_freqs(id, 1, itmp, info)
  409. #endif
  410. cpl_freq = itmp(1)
  411. ENDIF
  412. !
  413. END FUNCTION cpl_freq
  414. SUBROUTINE cpl_finalize
  415. !!---------------------------------------------------------------------
  416. !! *** ROUTINE cpl_finalize ***
  417. !!
  418. !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
  419. !! called explicitly before cpl_init it will also close
  420. !! MPI communication.
  421. !!----------------------------------------------------------------------
  422. !
  423. DEALLOCATE( exfld )
  424. IF (nstop == 0) THEN
  425. CALL oasis_terminate( nerror )
  426. ELSE
  427. CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
  428. ENDIF
  429. !
  430. END SUBROUTINE cpl_finalize
  431. #if ! defined key_oasis3
  432. !!----------------------------------------------------------------------
  433. !! No OASIS Library OASIS3 Dummy module...
  434. !!----------------------------------------------------------------------
  435. SUBROUTINE oasis_init_comp(k1,cd1,k2)
  436. CHARACTER(*), INTENT(in ) :: cd1
  437. INTEGER , INTENT( out) :: k1,k2
  438. k1 = -1 ; k2 = -1
  439. WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
  440. END SUBROUTINE oasis_init_comp
  441. SUBROUTINE oasis_abort(k1,cd1,cd2)
  442. INTEGER , INTENT(in ) :: k1
  443. CHARACTER(*), INTENT(in ) :: cd1,cd2
  444. WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
  445. END SUBROUTINE oasis_abort
  446. SUBROUTINE oasis_get_localcomm(k1,k2)
  447. INTEGER , INTENT( out) :: k1,k2
  448. k1 = -1 ; k2 = -1
  449. WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
  450. END SUBROUTINE oasis_get_localcomm
  451. SUBROUTINE oasis_def_partition(k1,k2,k3,k4)
  452. INTEGER , INTENT( out) :: k1,k3
  453. INTEGER , INTENT(in ) :: k2(5)
  454. INTEGER , INTENT(in ) :: k4
  455. k1 = k2(1) ; k3 = k2(5)+k4
  456. WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
  457. END SUBROUTINE oasis_def_partition
  458. SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
  459. CHARACTER(*), INTENT(in ) :: cd1
  460. INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6
  461. INTEGER , INTENT( out) :: k1,k7
  462. k1 = -1 ; k7 = -1
  463. WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
  464. END SUBROUTINE oasis_def_var
  465. SUBROUTINE oasis_enddef(k1)
  466. INTEGER , INTENT( out) :: k1
  467. k1 = -1
  468. WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
  469. END SUBROUTINE oasis_enddef
  470. SUBROUTINE oasis_put(k1,k2,p1,k3)
  471. REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1
  472. INTEGER , INTENT(in ) :: k1,k2
  473. INTEGER , INTENT( out) :: k3
  474. k3 = -1
  475. WRITE(numout,*) 'oasis_put: Error you sould not be there...'
  476. END SUBROUTINE oasis_put
  477. SUBROUTINE oasis_get(k1,k2,p1,k3)
  478. REAL(wp), DIMENSION(:,:), INTENT( out) :: p1
  479. INTEGER , INTENT(in ) :: k1,k2
  480. INTEGER , INTENT( out) :: k3
  481. p1(1,1) = -1. ; k3 = -1
  482. WRITE(numout,*) 'oasis_get: Error you sould not be there...'
  483. END SUBROUTINE oasis_get
  484. SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
  485. INTEGER , INTENT(in ) :: k1,k2
  486. INTEGER, DIMENSION(1), INTENT( out) :: k3
  487. INTEGER , INTENT( out) :: k4
  488. k3(1) = k1 ; k4 = k2
  489. WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
  490. END SUBROUTINE oasis_get_freqs
  491. SUBROUTINE oasis_terminate(k1)
  492. INTEGER , INTENT( out) :: k1
  493. k1 = -1
  494. WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
  495. END SUBROUTINE oasis_terminate
  496. #endif
  497. !!=====================================================================
  498. END MODULE cpl_oasis3