New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8280 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2017-07-05T10:28:51+02:00 (7 years ago)
Author:
timgraham
Message:

331: Merge of MEDUSA stable branch and HadGEM3 coupling branches into GO6 package branch.

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO
Files:
34 edited
4 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r6486 r8280  
    124124 
    125125    CASE DEFAULT 
    126        IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' 
    127        STOP 'dia_wri_dimg' 
     126     
     127       WRITE(numout,*) 'dia_wri_dimg : E R R O R : bad cd_type in dia_wri_dimg' 
     128       CALL ctl_stop( 'STOP', 'dia_wri_dimg :bad cd_type in dia_wri_dimg ' ) 
    128129 
    129130    END SELECT 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7651 r8280  
    11161116      ENDIF 
    11171117#endif 
     1118 
     1119      IF (cdfile_name == "output.abort") THEN 
     1120         CALL ctl_stop('MPPSTOP', 'NEMO abort from dia_wri_state') 
     1121      END IF 
    11181122        
    11191123!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r6486 r8280  
    112112    IF( inbsel >  jpk ) THEN 
    113113       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk 
    114        STOP 
     114       CALL ctl_stop('STOP', 'NEMO aborted from dia_wri') 
    115115    ENDIF 
    116116 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6491 r8280  
    550550      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    551551      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    552       IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' ) 
     552      IF( lk_mpp )   CALL ctl_stop('STOP', ' mpp version is not yet implemented' ) 
    553553 
    554554      ! mask for second order calculation of vorticity 
    … …  
    572572         WRITE(numout,*) ' symetric boundary conditions need special' 
    573573         WRITE(numout,*) ' treatment not implemented. we stop.' 
    574          STOP 
     574         CALL ctl_stop('STOP', 'NEMO abort from dom_msk_nsa') 
    575575      ENDIF 
    576576       

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r6486 r8280  
    465465            END DO 
    466466         ELSE 
    467             IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
    468             IF(lwp)WRITE(numout,*) '         We stop' 
    469             STOP 'ldfguv' 
     467             
     468            WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
     469            WRITE(numout,*) '         We stop' 
     470            CALL ctl_stop('STOP', 'ldfguv: Unexpected kahm value') 
     471 
    470472         ENDIF 
    471473         !                                             ! =============== 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6486 r8280  
    3838   USE wrk_nemo       ! Memory Allocation 
    3939   USE timing         ! Timing 
     40   USE lib_fortran 
    4041 
    4142 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7993 r8280  
    20492049 
    20502050   SUBROUTINE mppstop 
     2051    
     2052#if defined key_oasis3 
     2053   USE mod_oasis      ! coupling routines 
     2054#endif 
     2055 
    20512056      !!---------------------------------------------------------------------- 
    20522057      !!                  ***  routine mppstop  *** 
    … …  
    20582063      !!---------------------------------------------------------------------- 
    20592064      ! 
     2065       
     2066#if defined key_oasis3 
     2067      ! If we're trying to shut down cleanly then we need to consider the fact 
     2068      ! that this could be part of an MPMD configuration - we don't want to 
     2069      ! leave other components deadlocked. 
     2070 
     2071      CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 
     2072 
     2073 
     2074#else 
     2075       
    20602076      CALL mppsync 
    20612077      CALL mpi_finalize( info ) 
     2078#endif 
     2079 
    20622080      ! 
    20632081   END SUBROUTINE mppstop 
    … …  
    38843902      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice) 
    38853903      ! 
     3904      IF( cd1 == 'MPPSTOP' ) THEN 
     3905         IF(lwp) WRITE(numout,*)  'E R R O R: Calling mppstop' 
     3906         CALL mppstop() 
     3907      ENDIF 
    38863908      IF( cd1 == 'STOP' ) THEN 
    38873909         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    … …  
    39884010            WRITE(kout,*) 
    39894011         ENDIF 
    3990          STOP 'ctl_opn bad opening' 
     4012         CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 
    39914013      ENDIF 
    39924014 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r6486 r8280  
    3131   USE in_out_manager               ! I/O manager 
    3232   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    33  
     33    
    3434   IMPLICIT NONE 
    3535   PRIVATE 
    … …  
    4141   PUBLIC   cpl_freq 
    4242   PUBLIC   cpl_finalize 
     43#if defined key_mpp_mpi 
     44   INCLUDE 'mpif.h' 
     45#endif 
     46    
     47   INTEGER, PARAMETER         :: localRoot  = 0 
     48   LOGICAL                    :: commRank            ! true for ranks doing OASIS communication 
     49#if defined key_cpl_rootexchg 
     50   LOGICAL                    :: rootexchg =.true.   ! logical switch  
     51#else 
     52   LOGICAL                    :: rootexchg =.false.  ! logical switch  
     53#endif  
    4354 
    4455   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    … …  
    8293 
    8394   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    84  
     95   INTEGER, PUBLIC :: localComm  
     96       
    8597   !!---------------------------------------------------------------------- 
    8698   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    120132      IF ( nerror /= OASIS_Ok ) & 
    121133         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     134      localComm = kl_comm  
    122135      ! 
    123136   END SUBROUTINE cpl_init 
    … …  
    177190      IF( nerror > 0 ) THEN 
    178191         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    179       ENDIF 
     192      ENDIF       
    180193      ! 
    181194      ! ----------------------------------------------------------------- 
    182195      ! ... Define the partition  
    183196      ! ----------------------------------------------------------------- 
    184        
     197             
    185198      paral(1) = 2                                              ! box partitioning 
    186199      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
    … …  
    196209      ENDIF 
    197210       
    198       CALL oasis_def_partition ( id_part, paral, nerror ) 
     211      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 
    199212      ! 
    200213      ! ... Announce send variables.  
    … …  
    241254            END DO 
    242255         ENDIF 
    243       END DO 
     256      END DO       
    244257      ! 
    245258      ! ... Announce received variables.  
    … …  
    373386            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    374387 
    375                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     388               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )    
    376389                
    377390               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    … …  
    384397                  kinfo = OASIS_Rcv 
    385398                  IF( llfisrt ) THEN  
    386                      pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     399                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)  
    387400                     llfisrt = .FALSE. 
    388401                  ELSE 
    … …  
    463476         CALL oasis_get_freqs(id, mop, 1, itmp, info) 
    464477#else 
     478#if defined key_oasis3  
     479         itmp(1) = namflddti( id ) 
     480#else 
    465481         CALL oasis_get_freqs(id,      1, itmp, info) 
     482#endif 
    466483#endif 
    467484         cpl_freq = itmp(1) 
    … …  
    514531   END SUBROUTINE oasis_get_localcomm 
    515532 
    516    SUBROUTINE oasis_def_partition(k1,k2,k3) 
     533   SUBROUTINE oasis_def_partition(k1,k2,k3,K4) 
    517534      INTEGER     , INTENT(  out) ::  k1,k3 
    518535      INTEGER     , INTENT(in   ) ::  k2(5) 
     536      INTEGER     , OPTIONAL, INTENT(in   ) ::  k4 
    519537      k1 = k2(1) ; k3 = k2(5) 
    520538      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r6486 r8280  
    5151 
    5252   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    53                        px2 , py2 ) 
     53                       px2 , py2 , kchoix  ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE repcmo  *** 
    … …  
    6868      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
    6969      !!---------------------------------------------------------------------- 
    70        
    71       ! Change from geographic to stretched coordinate 
    72       ! ---------------------------------------------- 
    73       CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
    74       CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
    75        
     70      INTEGER, INTENT( IN ) ::   & 
     71         kchoix   ! type of transformation 
     72                  ! = 1 change from geographic to model grid. 
     73                  ! =-1 change from model to geographic grid 
     74      !!---------------------------------------------------------------------- 
     75  
     76      SELECT CASE (kchoix) 
     77      CASE ( 1) 
     78        ! Change from geographic to stretched coordinate 
     79        ! ---------------------------------------------- 
     80      
     81        CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
     82        CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
     83      CASE (-1) 
     84       ! Change from stretched to geographic coordinate 
     85       ! ---------------------------------------------- 
     86      
     87       CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 
     88       CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 
     89     END SELECT 
     90      
    7691   END SUBROUTINE repcmo 
    7792 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8046 r8280  
    3434   USE geo2ocean       !  
    3535   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev,            & 
    36                       CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, Dust_in_cpl, & 
     36                      CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl,            &  
     37                      PCO2a_in_cpl, Dust_in_cpl, & 
    3738                      ln_medusa 
    3839   USE albedo          ! 
    … …  
    145146   INTEGER, PARAMETER ::   jps_sstfrz = 32            ! sea-surface freezing temperature 
    146147   INTEGER, PARAMETER ::   jps_fice1  = 33            ! first-order ice concentration (for time-travelling ice coupling) 
    147    INTEGER, PARAMETER ::   jps_bio_co2 = 34           ! MEDUSA air-sea CO2 flux in 
    148    INTEGER, PARAMETER ::   jps_bio_dms = 35           ! MEDUSA DMS surface concentration in 
    149    INTEGER, PARAMETER ::   jpsnd      = 35            ! total number of fields sent 
     148   INTEGER, PARAMETER ::   jps_bio_co2 = 34           ! MEDUSA air-sea CO2 flux 
     149   INTEGER, PARAMETER ::   jps_bio_dms = 35           ! MEDUSA DMS surface concentration 
     150   INTEGER, PARAMETER ::   jps_bio_chloro = 36        ! MEDUSA chlorophyll surface concentration 
     151   INTEGER, PARAMETER ::   jpsnd      = 36            ! total number of fields sent 
    150152 
    151153   REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6      ! Coversion factor to get outgong DMS in standard units for coupling 
    … …  
    162164   ! Send to the atmosphere                           ! 
    163165   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 
    164    TYPE(FLD_C) ::   sn_snd_bio_co2, sn_snd_bio_dms                        
     166   TYPE(FLD_C) ::   sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro                    
    165167 
    166168   ! Received from the atmosphere                     ! 
    … …  
    207209      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    208210#endif 
    209       ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     211      !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     212      ! Hardwire only two models as nn_cplmodel has not been read in 
     213      ! from the namelist yet. 
     214      ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) )    
    210215      ! 
    211216      sbc_cpl_alloc = MAXVAL( ierr ) 
    … …  
    246251 
    247252      ! Add MEDUSA related fields to namelist 
    248       NAMELIST/namsbc_cpl/  sn_snd_bio_co2, sn_snd_bio_dms,                                           & 
     253      NAMELIST/namsbc_cpl/  sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro,                        & 
    249254         &                  sn_rcv_atm_pco2, sn_rcv_atm_dust 
    250255 
    … …  
    304309         WRITE(numout,*)'      bio co2 flux                    = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 
    305310         WRITE(numout,*)'      bio dms flux                    = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 
     311         WRITE(numout,*)'      bio dms chlorophyll             = ', TRIM(sn_snd_bio_chloro%cldes), ' (', TRIM(sn_snd_bio_chloro%clcat), ')' 
    306312         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
    307313         WRITE(numout,*)'      ice effective conductivity      = ', TRIM(sn_snd_cond%cldes   ), ' (', TRIM(sn_snd_cond%clcat   ), ')' 
    … …  
    321327 
    322328      !                                   ! allocate sbccpl arrays 
    323       IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
     329      !IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    324330      
    325331      ! ================================ ! 
    … …  
    384390         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    385391         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    386          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     392         !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     393! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 
     394         srcv(jpr_otx1)%laction = .TRUE.  
     395         srcv(jpr_oty1)%laction = .TRUE. 
     396! 
    387397         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    388398      CASE( 'T,I' )  
    … …  
    826836      IF( TRIM(sn_snd_bio_co2%cldes) == 'medusa' )    ssnd(jps_bio_co2 )%laction = .TRUE. 
    827837       
     838      ! Surface chlorophyll from Medusa 
     839      ssnd(jps_bio_chloro)%clname = 'OBioChlo'    
     840      IF( TRIM(sn_snd_bio_chloro%cldes) == 'medusa' )    ssnd(jps_bio_chloro )%laction = .TRUE. 
     841 
    828842      !                                                      ! ------------------------- ! 
    829843      !                                                      ! Sea surface freezing temp ! 
    … …  
    10351049      INTEGER  ::   ji, jj, jl, jn         ! dummy loop indices 
    10361050      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     1051      INTEGER  ::   ikchoix 
    10371052      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    10381053      REAL(wp) ::   zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 
    … …  
    10431058      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    10441059      REAL(wp) ::   zzx, zzy               ! temporary variables 
    1045       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     1060      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    10461061      !!---------------------------------------------------------------------- 
    10471062 
    1048       ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 
    1049       ! until we know where they need to go. 
    1050       REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 
    1051       REAL(wp), ALLOCATABLE :: atm_dust(:,:) 
    1052  
    10531063      ! 
    10541064      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    10551065      ! 
    1056       CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1066      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    10571067      ! 
    10581068      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    … …  
    10921102            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    10931103               !                                                       ! (geographical to local grid -> rotate the components) 
    1094                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    1095                IF( srcv(jpr_otx2)%laction ) THEN 
    1096                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    1097                ELSE   
    1098                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     1104               IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 
     1105                  ! Temporary code for HadGEM3 - will be removed eventually. 
     1106        ! Only applies when we have only taux on U grid and tauy on V grid 
     1107             DO jj=2,jpjm1 
     1108                DO ji=2,jpim1 
     1109                     ztx(ji,jj)=0.25*vmask(ji,jj,1)                & 
     1110                        *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1)    & 
     1111                        +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 
     1112                     zty(ji,jj)=0.25*umask(ji,jj,1)                & 
     1113                        *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1)    & 
     1114                        +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 
     1115                ENDDO 
     1116             ENDDO 
     1117                    
     1118             ikchoix = 1 
     1119             CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 
     1120             CALL lbc_lnk (ztx2,'U', -1. ) 
     1121             CALL lbc_lnk (zty2,'V', -1. ) 
     1122             frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 
     1123             frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 
     1124          ELSE 
     1125             CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     1126             frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     1127             IF( srcv(jpr_otx2)%laction ) THEN 
     1128                CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     1129             ELSE 
     1130                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
     1131             ENDIF 
     1132          frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid   
    10991133               ENDIF 
    1100                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    1101                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    11021134            ENDIF 
    11031135            !                               
    … …  
    14191451 
    14201452      ! 
    1421       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1453      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    14221454      ! 
    14231455      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
    … …  
    21012133      ! 
    21022134      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     2135      INTEGER ::   ikchoix 
    21032136      INTEGER ::   isec, info   ! local integer 
    21042137      REAL(wp) ::   zumax, zvmax 
    … …  
    23472380 
    23482381      IF (ln_medusa) THEN 
    2349       !                                                      ! --------------------------------- ! 
    2350       !                                                      !  CO2 flux and DMS from MEDUSA     !  
    2351       !                                                      ! --------------------------------- ! 
     2382      !                                                      ! ---------------------------------------------- ! 
     2383      !                                                      !  CO2 flux, DMS and chlorophyll from MEDUSA     !  
     2384      !                                                      ! ---------------------------------------------- ! 
    23522385         IF ( ssnd(jps_bio_co2)%laction ) THEN 
    23532386            CALL cpl_snd( jps_bio_co2, isec, RESHAPE( CO2Flux_out_cpl, (/jpi,jpj,1/) ), info ) 
    … …  
    23562389         IF ( ssnd(jps_bio_dms)%laction )  THEN 
    23572390            CALL cpl_snd( jps_bio_dms, isec, RESHAPE( DMS_out_cpl, (/jpi,jpj,1/) ), info ) 
     2391         ENDIF 
     2392 
     2393         IF ( ssnd(jps_bio_chloro)%laction )  THEN 
     2394            CALL cpl_snd( jps_bio_chloro, isec, RESHAPE( chloro_out_cpl, (/jpi,jpj,1/) ), info ) 
    23582395         ENDIF 
    23592396      ENDIF 
    … …  
    23652402         !                                                  j+1   j     -----V---F 
    23662403         ! surface velocity always sent from T point                     !       | 
    2367          !                                                        j      |   T   U 
     2404         ! [except for HadGEM3]                                   j      |   T   U 
    23682405         !                                                               |       | 
    23692406         !                                                   j    j-1   -I-------| 
    … …  
    23772414            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    23782415            CASE( 'oce only'             )      ! C-grid ==> T 
    2379                DO jj = 2, jpjm1 
    2380                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    2381                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    2382                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2416               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2417                  DO jj = 2, jpjm1 
     2418                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     2419                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     2420                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2421                     END DO 
    23832422                  END DO 
    2384                END DO 
     2423               ELSE 
     2424! Temporarily Changed for UKV 
     2425                  DO jj = 2, jpjm1 
     2426                     DO ji = 2, jpim1 
     2427                        zotx1(ji,jj) = un(ji,jj,1) 
     2428                        zoty1(ji,jj) = vn(ji,jj,1) 
     2429                     END DO 
     2430                  END DO 
     2431               ENDIF  
    23852432            CASE( 'weighted oce and ice' )    
    23862433               SELECT CASE ( cp_ice_msh ) 
    … …  
    24412488                  END DO 
    24422489               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    2443                   DO jj = 2, jpjm1 
    2444                      DO ji = 2, jpim1   ! NO vector opt. 
    2445                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    2446                            &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    2447                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    2448                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    2449                            &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    2450                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2490                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2491                     DO jj = 2, jpjm1 
     2492                        DO ji = 2, jpim1   ! NO vector opt. 
     2493                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
     2494                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     2495                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2496                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
     2497                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     2498                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2499                        END DO 
    24512500                     END DO 
    2452                   END DO 
     2501#if defined key_cice 
     2502                  ELSE 
     2503! Temporarily Changed for HadGEM3 
     2504                     DO jj = 2, jpjm1 
     2505                        DO ji = 2, jpim1   ! NO vector opt. 
     2506                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
     2507                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
     2508                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
     2509                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     2510                        END DO 
     2511                     END DO 
     2512#endif 
     2513                  ENDIF 
    24532514               END SELECT 
    24542515            END SELECT 
    … …  
    24602521         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    24612522            !                                                                     ! Ocean component 
    2462             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    2463             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    2464             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    2465             zoty1(:,:) = ztmp2(:,:) 
    2466             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    2467                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    2468                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    2469                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    2470                zity1(:,:) = ztmp2(:,:) 
    2471             ENDIF 
     2523            IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2524               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2525               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2526               zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2527               zoty1(:,:) = ztmp2(:,:) 
     2528               IF( ssnd(jps_ivx1)%laction ) THEN                                  ! Ice component 
     2529                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2530                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2531                  zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2532                  zity1(:,:) = ztmp2(:,:) 
     2533               ENDIF 
     2534            ELSE 
     2535               ! Temporary code for HadGEM3 - will be removed eventually. 
     2536               ! Only applies when we want uvel on U grid and vvel on V grid 
     2537               ! Rotate U and V onto geographic grid before sending. 
     2538 
     2539               DO jj=2,jpjm1 
     2540                  DO ji=2,jpim1 
     2541                     ztmp1(ji,jj)=0.25*vmask(ji,jj,1)                  & 
     2542                          *(zotx1(ji,jj)+zotx1(ji-1,jj)    & 
     2543                          +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 
     2544                     ztmp2(ji,jj)=0.25*umask(ji,jj,1)                  & 
     2545                          *(zoty1(ji,jj)+zoty1(ji+1,jj)    & 
     2546                          +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 
     2547                  ENDDO 
     2548               ENDDO 
     2549                
     2550               ! Ensure any N fold and wrap columns are updated 
     2551               CALL lbc_lnk(ztmp1, 'V', -1.0) 
     2552               CALL lbc_lnk(ztmp2, 'U', -1.0) 
     2553                
     2554               ikchoix = -1 
     2555               CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 
     2556           ENDIF 
    24722557         ENDIF 
    24732558         ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r6500 r8280  
    302302      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    303303      ! 
     304      ! In coupled mode get extra fields from CICE for passing back to atmosphere 
     305  
     306      IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 
     307      !  
    304308      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
    305309      ! 
    … …  
    736740      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_hadgam') 
    737741      ! 
    738       IF( kt == nit000 )  THEN 
    739          IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    740          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    741       ENDIF 
    742  
    743742      !                                         ! =========================== ! 
    744743      !                                         !   Prepare Coupling fields   ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7993 r8280  
    266266      ENDIF 
    267267      ! 
    268       IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
    269       !                                                     !                                            (2) the use of nn_fsbc 
     268      IF( lk_oasis ) THEN 
     269         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )          
     270         CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     271                                      !                                            (2) the use of nn_fsbc 
     272      ENDIF 
    270273 
    271274!     nn_fsbc initialization if OPA-SAS coupling via OASIS 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r7179 r8280  
    327327               END DO 
    328328            ELSE 
    329                IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 
    330                IF(lwp) WRITE(numout,*) '         We stop' 
    331                STOP 'ldfght' 
     329               WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 
     330               WRITE(numout,*) '         We stop' 
     331               CALL ctl_stop( 'STOP', 'ldfght : unexpected kaht value') 
    332332            ENDIF 
    333333            !                                             ! =============== 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90

    r6486 r8280  
     1#if ! defined key_top 
    12MODULE trdtrc 
    23   !!====================================================================== 
    … …  
    2223   !!====================================================================== 
    2324END MODULE trdtrc 
     25#endif 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7563 r8280  
    6868   USE icbini          ! handle bergs, initialisation 
    6969   USE icbstp          ! handle bergs, calving, themodynamics and transport 
     70   USE sbccpl  
    7071   USE cpl_oasis3      ! OASIS3 coupling 
    7172   USE c1d             ! 1D configuration 
    … …  
    7475#if defined key_top 
    7576   USE trcini          ! passive tracer initialisation 
     77   USE trc, ONLY: numstr  ! tracer stats unit number 
    7678#endif 
    7779   USE lib_mpp         ! distributed memory computing 
    … …  
    169171            CALL stp                         ! AGRIF: time stepping 
    170172#else 
    171             CALL stp( istp )                 ! standard time stepping 
     173            IF (lk_oasis) CALL sbc_cpl_snd( istp )  ! Coupling to atmos 
     174       CALL stp( istp ) 
     175            ! We don't couple on the final timestep because 
     176            ! our restart file has already been written 
     177            ! and contains all the necessary data for a 
     178            ! restart. sbc_cpl_snd could be called here 
     179            ! but it would require 
     180            ! a) A test to ensure it was not performed 
     181            !    on the very last time-step 
     182            ! b) the presence of another call to 
     183            !    sbc_cpl_snd call prior to the main DO loop 
     184            ! This solution produces identical results 
     185            ! with fewer lines of code.  
    172186#endif 
    173187            istp = istp + 1 
    … …  
    283297      IF( Agrif_Root() ) THEN 
    284298         IF( lk_oasis ) THEN 
    285             CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
     299            CALL cpl_init( "toyoce", ilocal_comm )                     ! nemo local communicator given by oasis 
    286300            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    287301         ELSE 
    … …  
    294308      IF( lk_oasis ) THEN 
    295309         IF( Agrif_Root() ) THEN 
    296             CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
     310            CALL cpl_init( "toyoce", ilocal_comm )                      ! nemo local communicator given by oasis 
    297311         ENDIF 
    298312         ! Nodes selection (control print return in cltxt) 
    … …  
    474488      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    475489      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     490       
     491      IF (nstop > 0) THEN 
     492        CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 
     493      END IF 
     494 
    476495      ! 
    477496   END SUBROUTINE nemo_init 
    … …  
    609628      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    610629      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    611  
     630#if defined key_top 
     631      IF( numstr          /= -1 )   CLOSE( numstr          )   ! tracer statistics  
     632#endif 
    612633      ! 
    613634      numout = 6                                     ! redefine numout in case it is used after this point... 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r7770 r8280  
    7777   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: CO2Flux_out_cpl(:,:)  ! Output coupling CO2 flux   
    7878   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: DMS_out_cpl(:,:)      ! Output coupling DMS   
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: chloro_out_cpl(:,:)   ! Output coupling chlorophyll  
     80                                                                ! (expected in Kg/M3)   
    7981 
    8082   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: PCO2a_in_cpl(:,:)     ! Input coupling CO2 partial pressure  
    … …  
    138140         ! are enabled 
    139141         ALLOCATE( CO2Flux_out_cpl(jpi,jpj), DMS_out_cpl(jpi,jpj),               & 
     142                   chloro_out_cpl(jpi,jpj),                                      & 
    140143                   PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj),     STAT=ierr(5) ) 
    141144 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7962 r8280  
    380380      ! Coupled mode 
    381381      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    382       IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     382      !IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    383383      ! 
    384384#if defined key_iomput 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r6486 r8280  
    453453   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   & 
    454454      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    ) 
     455   USE in_out_manager, ONLY: numout 
    455456      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim 
    456457      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt 
    … …  
    483484         &      .AND. SUM( tree(ii)%ishape ) /= 0 ) 
    484485         ii = ii + 1 
    485          IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!) 
     486         IF (ii > jparray) THEN 
     487            WRITE(numout,*) "E R R O R: NEMO aborted wrk_allocbase" 
     488            FLUSH(numout) 
     489            STOP 'Increase the value of jparray' 
     490                           ! increase the value of jparray (should not be needed as already very big!) 
     491         END IF 
    486492      END DO 
    487493       

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r6486 r8280  
    1111   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1212 
     13   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA 
     14   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA 
     15   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA 
     16   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
     17 
     18   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in MEDUSA 
     19   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in MEDUSA 
     20   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in MEDUSA 
     21   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in MEDUSA 
     22 
    1323   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC 
    1424   USE par_cfc    , ONLY : jp_cfc_2d       !: number of 2D diag in CFC 
    … …  
    1929   IMPLICIT NONE 
    2030 
    21    INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
    22    INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_cfc_2d  !: 
    23    INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_cfc_3d  !: 
    24    INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_cfc_trd !: 
     31   INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_medusa     +   & 
     32                      jp_idtra      + jp_cfc                               !: cum. number of pass. tracers 
     33   INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_medusa_2d  +   & 
     34                      jp_idtra_2d   + jp_cfc_2d  !: 
     35   INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_medusa_3d  +   & 
     36                      jp_idtra_3d   + jp_cfc_3d  !: 
     37   INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_medusa_trd +   & 
     38                      jp_idtra_trd  + jp_cfc_trd !: 
    2539    
    2640#if defined key_c14b 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r6486 r8280  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
     7   !!                  !  2017-04  (A. Yool)  add SF6 
    78   !!---------------------------------------------------------------------- 
    89   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    1516   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1617 
     18   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA 
     19   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA 
     20   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA 
     21   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
     22 
     23   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in ideal tracer 
     24   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in ideal tracer 
     25   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in ideal tracer 
     26   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in ideal tracer 
     27 
    1728   IMPLICIT NONE 
    1829 
    19    INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     !: cumulative number of passive tracers 
    20    INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  !: 
    21    INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  !: 
    22    INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd !: 
     30   INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     + jp_medusa     + & 
     31                      jp_idtra     !: cumulative number of passive tracers 
     32   INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  + jp_medusa_2d  + & 
     33                      jp_idtra_2d !: 
     34   INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  + jp_medusa_3d  + & 
     35                      jp_idtra_3d !: 
     36   INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd + jp_medusa_trd + & 
     37                      jp_idtra_trd !: 
    2338    
    2439#if defined key_cfc 
    … …  
    2742   !!--------------------------------------------------------------------- 
    2843   LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag  
    29    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd') 
     44   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  3          !: number of passive tracers 
     45   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  6          !: additional 2d output arrays ('key_trc_diaadd') 
    3146   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
    3247   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
    … …  
    3449   ! assign an index in trc arrays for each CFC prognostic variables 
    3550   INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11  
    36    INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12    
     51   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12 (priority tracer for CMIP6) 
     52   INTEGER, PUBLIC, PARAMETER ::   jpsf6       = jp_lc + 3   !: SF6 
    3753#else 
    3854   !!--------------------------------------------------------------------- 
    … …  
    4763 
    4864   ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 
    49    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers 
    50    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers 
    51    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers 
     65   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1              !: First index of CFC tracers 
     66   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc         !: Last  index of CFC tracers 
     67   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1          !: First index of CFC tracers 
    5268   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1          !: First index of CFC tracers 
    5470   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
    55    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers 
    56    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers 
     71   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1          !: First index of CFC tracers 
     72   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last  index of CFC tracers 
    5773 
    5874   !!====================================================================== 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r6486 r8280  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
     7   !!                  !  2017-04  (A. Yool)  Add SF6 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_cfc 
    … …  
    2223   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module 
    2324 
    24    CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ??? 
     25   CHARACTER (len=34) ::   clname = 'cfc1112sf6.atm'   ! ??? 
    2526 
    2627   INTEGER  ::   inum                   ! unit number 
    … …  
    4445      !!---------------------------------------------------------------------- 
    4546      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr 
    46       INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
     47      INTEGER  ::  iskip = 7   ! number of 1st descriptor lines 
    4748      REAL(wp) ::  zyy, zyd 
    4849      !!---------------------------------------------------------------------- 
    … …  
    5354 
    5455 
    55       IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
     56      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm' 
    5657       
    5758      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    … …  
    6970      !                                ! Allocate CFC arrays 
    7071 
    71       ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr ) 
     72      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 
    7273      IF( ierr > 0 ) THEN 
    7374         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN 
    … …  
    9091         ENDIF 
    9192         qint_cfc(:,:,:) = 0._wp 
    92          DO jl = 1, jp_cfc 
    93             jn = jp_cfc0 + jl - 1 
    94             trn(:,:,:,jn) = 0._wp 
    95          END DO 
     93         trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
    9694      ENDIF 
    9795 
    … …  
    105103      jn = 31 
    106104      DO  
    107         READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
     105        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 
     106             & p_cfc(jn,1,3), p_cfc(jn,2,1),  & 
     107             & p_cfc(jn,2,2), p_cfc(jn,2,3) 
    108108        IF( io < 0 ) exit 
    109109        jn = jn + 1 
    110110      END DO 
    111111 
    112       p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
    113       p_cfc(33,1:2,1) = 8.e-4 
    114       p_cfc(34,1:2,1) = 1.e-6 
    115       p_cfc(35,1:2,1) = 2.e-3 
    116       p_cfc(36,1:2,1) = 4.e-3 
    117       p_cfc(37,1:2,1) = 6.e-3 
    118       p_cfc(38,1:2,1) = 8.e-3 
    119       p_cfc(39,1:2,1) = 1.e-2 
     112      ! AXY (25/04/17): do not adjust 
     113      ! p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
     114      ! p_cfc(33,1:2,1) = 8.e-4 
     115      ! p_cfc(34,1:2,1) = 1.e-6 
     116      ! p_cfc(35,1:2,1) = 2.e-3 
     117      ! p_cfc(36,1:2,1) = 4.e-3 
     118      ! p_cfc(37,1:2,1) = 6.e-3 
     119      ! p_cfc(38,1:2,1) = 8.e-3 
     120      ! p_cfc(39,1:2,1) = 1.e-2 
    120121       
    121122      IF(lwp) THEN        ! Control print 
    122123         WRITE(numout,*) 
    123          WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
     124         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS    pSF6N    pSF6S ' 
    124125         DO jn = 30, jpyear 
    125             WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     126            WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), & 
     127                 & p_cfc(jn,1,2), p_cfc(jn,2,2), & 
     128                 & p_cfc(jn,1,3), p_cfc(jn,2,3) 
    126129         END DO 
    127130      ENDIF 
    128  
    129131 
    130132      ! Interpolation factor of atmospheric partial pressure 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r6486 r8280  
    4949      TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5050      !! 
    51       NAMELIST/namcfcdate/ ndate_beg, nyear_res 
     51      NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type  
    5252      NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
    5353      !!---------------------------------------------------------------------- 
    … …  
    7272         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg 
    7373         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res 
     74         IF (simu_type==1) THEN 
     75            WRITE(numout,*) ' CFC running on SPIN-UP mode             simu_type = ', simu_type 
     76         ELSEIF (simu_type==2) THEN 
     77            WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type 
     78         ENDIF 
    7479      ENDIF 
    7580      nyear_beg = ndate_beg / 10000 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6486 r8280  
    77   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity 
    88   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
     9   !!                 !  2016-06  (J. Palmieri)  update for UKESM1 
     10   !!                 !  2017-04  (A. Yool)  update to add SF6, fix coefficients 
    911   !!---------------------------------------------------------------------- 
    1012#if defined key_cfc 
    … …  
    1517   !!   cfc_init     :  sets constants for CFC surface forcing computation 
    1618   !!---------------------------------------------------------------------- 
     19   USE dom_oce       ! ocean space and time domain 
    1720   USE oce_trc       ! Ocean variables 
    1821   USE par_trc       ! TOP parameters 
    … …  
    3134   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
    3235   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
     36   INTEGER , PUBLIC            ::   simu_type      ! Kind of simulation: 1- Spin-up  
     37                                                   !                     2- Hindcast/projection 
    3338   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3439   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
    … …  
    4045   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4146 
    42    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    43    REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
     47   REAL(wp), DIMENSION(4,3) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
     48   REAL(wp), DIMENSION(3,3) ::   sob   !    "               " 
     49   REAL(wp), DIMENSION(5,3) ::   sca   ! coefficients for schmidt number in degre Celcius 
    4550       
    4651   !                          ! coefficients for conversion 
    … …  
    7984      ! 
    8085      INTEGER  ::   ji, jj, jn, jl, jm, js 
    81       INTEGER  ::   iyear_beg, iyear_end 
     86      INTEGER  ::   iyear_beg, iyear_end, iyear_tmp 
    8287      INTEGER  ::   im1, im2, ierr 
    8388      REAL(wp) ::   ztap, zdtap         
    84       REAL(wp) ::   zt1, zt2, zt3, zv2 
     89      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8590      REAL(wp) ::   zsol      ! solubility 
    8691      REAL(wp) ::   zsch      ! schmidt number  
    … …  
    103108      ! Temporal interpolation 
    104109      ! ---------------------- 
    105       iyear_beg = nyear - 1900 
     110      !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run: 
     111      !!                     1- the SPIN-UP and 2- Hindcast/Projections 
     112      !!                     -- main difference is the way to define the year of 
     113      !!                     simulation, that determine the atm pCFC. 
     114      !!                     1-- Spin-up: our atm forcing is of 30y we cycle on. 
     115      !!                     So we do 90y CFC cycles to be in good 
     116      !!                     correspondence with the atmosphere 
     117      !!                     2-- Hindcast/proj, instead of nyear-1900 we keep 
     118      !!                     the 2 last digit, and enable 3 cycle from 1800 to 2100.   
     119      !!---------------------------------------------------------------------- 
     120      IF (simu_type==1) THEN 
     121         !! 1 -- SPIN-UP 
     122         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000 
     123         iyear_beg = MOD( iyear_tmp , 90 ) 
     124         !! JPALM -- the pCFC file only got 78 years. 
     125         !!       So if iyear_beg > 78 then we set pCFC to 0 
     126         !!             iyear_beg = 0 as well -- must try to avoid obvious problems 
     127         !!             as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10 
     128         !!          else, must add 30 to iyear_beg to match with P_cfc indices 
     129         !!--------------------------------------- 
     130         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 
     131            iyear_beg = 10 
     132         ELSE  
     133            iyear_beg = iyear_beg + 30 
     134         ENDIF 
     135      ELSEIF (simu_type==2) THEN 
     136         !! 2 -- Hindcast/proj 
     137         iyear_beg = MOD(nyear, 100) 
     138         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100 
     139         !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 
     140         !!       we want to set p_CFC to 0.00 --> set iyear_beg = 10 
     141         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) iyear_beg = 10              
     142      ENDIF 
     143      !! 
    106144      IF ( nmonth <= 6 ) THEN 
    107145         iyear_beg = iyear_beg - 1 
    … …  
    152190               zt2  = zt1 * zt1  
    153191               zt3  = zt1 * zt2 
    154                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
     192               zt4  = zt1 * zt3 
     193               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    155194 
    156195               !    speed transfert : formulae of wanninkhof 1992 
    157196               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    158197               zsch    = zsch / 660. 
    159                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     198               ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value 
     199               ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     200               zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    160201 
    161202               ! Input function  : speed *( conc. at equil - concen at surface ) 
    … …  
    176217         !                                                  !----------------! 
    177218      END DO                                                !  end CFC loop  ! 
    178       ! 
    179       IF( lrst_trc ) THEN 
    180          IF(lwp) WRITE(numout,*) 
    181          IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
    182             &                    'at it= ', kt,' date= ', ndastp 
    183          IF(lwp) WRITE(numout,*) '~~~~' 
    184          DO jn = jp_cfc0, jp_cfc1 
    185             CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
    186          END DO 
    187       ENDIF                                             
     219         ! 
     220      IF( kt == nittrc000 ) THEN 
     221         DO jl = 1, jp_cfc    
     222             WRITE(NUMOUT,*) ' ' 
     223             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm   
     224             WRITE(NUMOUT,*) '################################## ' 
     225             WRITE(NUMOUT,*) ' ' 
     226               if (jl.EQ.1) then 
     227                   WRITE(NUMOUT,*) 'Traceur = CFC11: ' 
     228               elseif (jl.EQ.2) then 
     229                   WRITE(NUMOUT,*) 'Traceur = CFC12: ' 
     230               elseif (jl.EQ.3) then 
     231                   WRITE(NUMOUT,*) 'Traceur = SF6: ' 
     232               endif 
     233             WRITE(NUMOUT,*) 'nyear    = ', nyear 
     234             WRITE(NUMOUT,*) 'nmonth   = ', nmonth 
     235             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 
     236             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 
     237             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 
     238             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 
     239             WRITE(NUMOUT,*) 'Im1= ',im1 
     240             WRITE(NUMOUT,*) 'Im2= ',im2 
     241             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 
     242             WRITE(NUMOUT,*) ' ' 
     243         END DO   
     244# if defined key_debug_medusa 
     245         CALL flush(numout) 
     246# endif 
     247      ENDIF 
     248        ! 
     249      !IF( lrst_trc ) THEN 
     250      !   IF(lwp) WRITE(numout,*) 
     251      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
     252      !      &                    'at it= ', kt,' date= ', ndastp 
     253      !   IF(lwp) WRITE(numout,*) '~~~~' 
     254      !   DO jn = jp_cfc0, jp_cfc1 
     255      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     256      !   END DO 
     257      !ENDIF                                             
    188258      ! 
    189259      IF( lk_iomput ) THEN 
    190          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    191          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     260         IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     261         IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     262         IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
     263         IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
     264         IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
     265         IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    192266      ELSE 
    193267         IF( ln_diatrc ) THEN 
    194268            trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    195269            trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
     270            trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 
     271            trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 
     272            trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 
     273            trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 
    196274         END IF 
    197275      END IF 
    … …  
    203281      END IF 
    204282      ! 
     283# if defined key_debug_medusa 
     284      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing 
     285      CALL flush(numout) 
     286# endif 
    205287      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc') 
    206288      ! 
    … …  
    214296      !! ** Purpose : sets constants for CFC model 
    215297      !!--------------------------------------------------------------------- 
    216       INTEGER :: jn 
     298      INTEGER :: jl, jn, iyear_beg, iyear_tmp 
    217299 
    218300      ! coefficient for CFC11  
    … …  
    223305      soa(2,1) =  319.6552 
    224306      soa(3,1) =  119.4471 
    225       soa(4,1) =  -1.39165 
    226  
    227       sob(1,1) =  -0.142382 
    228       sob(2,1) =   0.091459 
    229       sob(3,1) =  -0.0157274 
    230  
    231       ! Schmidt number  
    232       sca(1,1) = 3501.8 
    233       sca(2,1) = -210.31 
    234       sca(3,1) =  6.1851 
    235       sca(4,1) = -0.07513 
     307      soa(4,1) =   -1.39165 
     308 
     309      sob(1,1) = -0.142382 
     310      sob(2,1) =  0.091459 
     311      sob(3,1) = -0.0157274 
     312 
     313      ! Schmidt number          AXY (25/04/17) 
     314      sca(1,1) = 3579.2       ! = 3501.8 
     315      sca(2,1) = -222.63      ! = -210.31 
     316      sca(3,1) =    7.5749    ! =    6.1851 
     317      sca(4,1) =   -0.14595   ! =   -0.07513 
     318      sca(5,1) =    0.0011874 ! = absent 
    236319 
    237320      ! coefficient for CFC12  
    … …  
    242325      soa(2,2) =  298.9702 
    243326      soa(3,2) =  113.8049 
    244       soa(4,2) =  -1.39165 
    245  
    246       sob(1,2) =  -0.143566 
    247       sob(2,2) =   0.091015 
    248       sob(3,2) =  -0.0153924 
    249  
    250       ! schmidt number  
    251       sca(1,2) =  3845.4  
    252       sca(2,2) =  -228.95 
    253       sca(3,2) =  6.1908  
    254       sca(4,2) =  -0.067430 
    255  
    256       IF( ln_rsttr ) THEN 
    257          IF(lwp) WRITE(numout,*) 
    258          IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 
    259          IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    260          ! 
    261          DO jn = jp_cfc0, jp_cfc1 
    262             CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
    263          END DO 
     327      soa(4,2) =   -1.39165 
     328 
     329      sob(1,2) = -0.143566 
     330      sob(2,2) =  0.091015 
     331      sob(3,2) = -0.0153924 
     332 
     333      ! schmidt number         AXY (25/04/17) 
     334      sca(1,2) = 3828.1      ! = 3845.4  
     335      sca(2,2) = -249.86     ! = -228.95 
     336      sca(3,2) =    8.7603   ! =    6.1908  
     337      sca(4,2) =   -0.1716   ! =   -0.067430 
     338      sca(5,2) =    0.001408 ! = absent 
     339 
     340      ! coefficients for SF6   AXY (25/04/17) 
     341      !--------------------- 
     342       
     343      ! Solubility 
     344      soa(1,3) =  -80.0343 
     345      soa(2,3) =  117.232 
     346      soa(3,3) =   29.5817 
     347      soa(4,3) =    0.0 
     348 
     349      sob(1,3) =  0.0335183 
     350      sob(2,3) = -0.0373942 
     351      sob(3,3) =  0.00774862 
     352 
     353      ! Schmidt number 
     354      sca(1,3) = 3177.5 
     355      sca(2,3) = -200.57 
     356      sca(3,3) =    6.8865 
     357      sca(4,3) =   -0.13335 
     358      sca(5,3) =    0.0010877 
     359 
     360      !!--------------------------------------------- 
     361      !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 
     362      !!       Or if out of P_cfc range 
     363      IF (simu_type==1) THEN 
     364         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000 
     365         iyear_beg = MOD( iyear_tmp , 90 ) 
     366         !!--------------------------------------- 
     367         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 
     368            qtr_cfc(:,:,:) = 0._wp 
     369            IF(lwp) THEN 
     370               WRITE(numout,*)  
     371               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     372               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     373               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     374               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     375            ENDIF 
     376            qtr_cfc(:,:,:) = 0._wp 
     377            qint_cfc(:,:,:) = 0._wp 
     378            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     379            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     380         ENDIF 
     381      !! 
     382      !! 2 -- Hindcast/proj 
     383      ELSEIF (simu_type==2) THEN 
     384         iyear_beg = MOD(nyear, 100) 
     385         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100 
     386         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN 
     387            qtr_cfc(:,:,:) = 0._wp 
     388            IF(lwp) THEN 
     389               WRITE(numout,*) 
     390               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     391               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     392               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     393               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     394            ENDIF 
     395            qtr_cfc(:,:,:) = 0._wp 
     396            qint_cfc(:,:,:) = 0._wp 
     397            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     398            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     399         ENDIF 
    264400      ENDIF 
     401 
    265402      IF(lwp) WRITE(numout,*) 
    266403      ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r7203 r8280  
    2929   USE trdtra 
    3030   USE prtctl_trc      ! Print control 
     31   !! USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3132 
    3233   IMPLICIT NONE 
    … …  
    7374      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7475      ! 
    75       INTEGER ::   jk  
     76      INTEGER ::   jk, jn  
    7677      CHARACTER (len=22) ::   charout 
    7778      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    … …  
    108109      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    109110      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
     111      !  
     112      !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...  
     113      !! DO jn = 1, jptra 
     114      !!   CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
     115      !!   CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
     116      !! END DO 
     117      ! 
    110118 
    111119      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6498 r8280  
    102102         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    103103 
    104          IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
    105             iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
    106             IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
    107             zfact = 0.5_wp 
    108             DO jn = 1, jptra 
    109                CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
    110             END DO 
    111          ELSE                                         ! No restart or restart not found: Euler forward time stepping 
     104         !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this... 
     105         !!                     -- set sbc_trc_b to 0 after restart, first, to check. 
     106         !!------------------------------------------------------------------------------ 
     107        ! IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     108        !    iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
     109        !    IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
     110        !    zfact = 0.5_wp 
     111        !    DO jn = 1, jptra 
     112        !       CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     113        !    END DO 
     114        ! ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    112115           zfact = 1._wp 
    113116           sbc_trc_b(:,:,:) = 0._wp 
    114         ENDIF 
     117        ! ENDIF 
    115118      ELSE                                         ! Swap of forcing fields 
    116119         IF( ln_top_euler ) THEN 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6498 r8280  
    2727   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     29# if defined key_debug_medusa 
     30   USE trcrst 
     31# endif 
     32 
    2933 
    3034#if defined key_agrif 
    … …  
    6569         ! 
    6670                                CALL trc_sbc( kstp )            ! surface boundary condition 
     71# if defined key_debug_medusa 
     72         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp 
     73         CALL trc_rst_tra_stat 
     74         CALL flush(numout) 
     75# endif 
    6776         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    6877         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    6978                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
     79# if defined key_debug_medusa 
     80         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 
     81         CALL trc_rst_tra_stat 
     82         CALL flush(numout) 
     83# endif 
    7084                                CALL trc_ldf( kstp )            ! lateral mixing 
    7185         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    … …  
    7589#endif 
    7690                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     91# if defined key_debug_medusa 
     92         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 
     93         CALL trc_rst_tra_stat 
     94         CALL flush(numout) 
     95# endif 
    7796                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     97# if defined key_debug_medusa 
     98         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 
     99         CALL trc_rst_tra_stat 
     100         CALL flush(numout) 
     101# endif 
    78102         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    79103         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r7203 r8280  
    88   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    99   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
     10   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2 
    1011   !!---------------------------------------------------------------------- 
    1112   USE par_kind          ! kind parameters 
    … …  
    1516   USE par_cfc       ! CFC 11 and 12 tracers 
    1617   USE par_my_trc    ! user defined passive tracers 
     18   USE par_medusa    ! MEDUSA model 
     19   USE par_idtra     ! Idealize tracer 
     20   USE par_age       ! AGE  tracer 
    1721 
    1822   IMPLICIT NONE 
    … …  
    2428   ! Passive tracers : Total size 
    2529   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     30   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra     + jp_age 
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d  + jp_age_2d 
     32   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d  + jp_age_3d 
    2933   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     34   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 
    3135    
    3236   !  1D configuration ("key_c1d") 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r6486 r8280  
    77   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    88   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
     9   !!             3.6  !  2016-11  (A. Yool)  Updated diags for CMIP6 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_top 
    … …  
    2526   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg 
    2627   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top 
    27    INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
     28   INTEGER, PUBLIC                                                 ::   numstr     = -1   !: logical unit for tracer statistics 
    2829   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read ) 
    2930   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write ) 
    … …  
    104105   END TYPE DIAG 
    105106 
     107#if defined key_medusa && defined key_iomput 
     108   TYPE, PUBLIC :: BDIAG 
     109      LOGICAL              :: dgsave 
     110   END TYPE BDIAG 
     111    
     112   TYPE, PUBLIC :: DIAG_IOM 
     113      TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn,            & 
     114                  GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC,  & 
     115                  SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM,        & 
     116                  PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100,    & 
     117                  REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100,      & 
     118                  FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100,    & 
     119                  FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN,      & 
     120                  REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, & 
     121                  MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, & 
     122                  OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND,    & 
     123                  ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG,  & 
     124                  TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG,   & 
     125                  N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500,       & 
     126                  RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C,       & 
     127                  OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI,     & 
     128                  RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK,      & 
     129                  INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N,       & 
     130                  ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D,       & 
     131                  ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC,                & 
     132                  INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN,        & 
     133                  DMS_HALL, DMS_ANDM, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2,           & 
     134                  OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2,                                          & ! end of regular 2D 
     135                  TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3,                                             & ! end of regular 3D 
     136! AXY (11/11/16): additional CMIP6 2D diagnostics 
     137                  epC100, epCALC100, epN100, epSI100,                                                & 
     138                  FGCO2, INTDISSIC, INTDISSIN, INTDISSISI, INTTALK, O2min, ZO2min,                   & 
     139                  FBDDTALK, FBDDTDIC, FBDDTDIFE, FBDDTDIN, FBDDTDISI,                                &  
     140! AXY (11/11/16): additional CMIP6 3D diagnostics 
     141                  TPPD3,                                                                             & 
     142                  BDDTALK3, BDDTDIC3, BDDTDIFE3, BDDTDIN3, BDDTDISI3,                                &  
     143                  FD_NIT3, FD_SIL3, FD_CAR3, FD_CAL3,                                                &  
     144                  CO33, CO3SATARAG3, CO3SATCALC3, DCALC3,                                            & 
     145                  EXPC3, EXPN3, EXPCALC3, EXPSI3,                                                    & 
     146                  FEDISS3, FESCAV3,                                                                  & 
     147                  MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3,                                  & 
     148                  O2SAT3, PBSI3, PCAL3, REMOC3,                                                      & 
     149                  PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3        
     150                  !! 
     151                  !! list of all MEDUSA diagnostics that could be called by iom_use 
     152   END TYPE DIAG_IOM   
     153   !! 
     154   TYPE(DIAG_IOM), PUBLIC :: med_diag  ! define which diagnostics are asked in outputs 
     155# endif                    
     156 
    106157   !! information for inputs 
    107158   !! -------------------------------------------------- 
    … …  
    216267 
    217268      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
     269 
     270      ! It is known that not intialising SBC_TRC can introduce NaNs 
     271      sbc_trc(:,:,:) = 0.0 
     272 
    218273      ! 
    219274   END FUNCTION trc_alloc 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7203 r8280  
    88   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture 
    99   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 
     10   !!             -   ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_top 
    … …  
    2425   USE trcini_c14b     ! C14 bomb initialisation 
    2526   USE trcini_my_trc   ! MY_TRC   initialisation 
     27   USE trcini_medusa   ! MEDUSA   initialisation 
     28   USE trcini_idtra    ! idealize tracer initialisation 
     29   USE trcini_age      ! AGE      initialisation 
    2630   USE trcdta          ! initialisation from files 
    2731   USE daymod          ! calendar manager 
    … …  
    7680         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    7781         & Computation of a daily mean shortwave for some biogeochemical models) ') 
    78  
     82          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     83          !!!!! CHECK For MEDUSA 
     84          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    7985      IF( nn_cla == 1 )   & 
    8086         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    … …  
    97103 
    98104      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
     105      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
     106      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    99107      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    100108      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
     109      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
    101110      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    102111 
    103112      CALL trc_ice_ini                                 ! Tracers in sea ice 
    104113 
    105       IF( lwp ) THEN 
     114# if defined key_debug_medusa 
     115         IF (lwp) write (numout,*) '------------------------------' 
     116         IF (lwp) write (numout,*) 'Jpalm - debug' 
     117         IF (lwp) write (numout,*) ' in trc_init' 
     118         IF (lwp) write (numout,*) ' sms init OK' 
     119         IF (lwp) write (numout,*) ' next: open tracer.stat' 
     120         IF (lwp) write (numout,*) ' ' 
     121         CALL flush(numout) 
     122# endif 
     123 
     124      IF( ln_ctl ) THEN 
    106125         ! 
    107          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     126         IF (narea == 1) THEN   
     127            ! The tracer.stat file only contains global tracer sum values, if  
     128            ! it contains anything at all. Hence it only needs to be opened  
     129            ! and written to on the master PE, not on all PEs.   
     130            CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED',  &  
     131                          'SEQUENTIAL', -1, numout, lwp , narea )  
     132         ENDIF   
    108133         ! 
    109134      ENDIF 
    110135 
    111       IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    112  
     136# if defined key_debug_medusa 
     137         IF (lwp) write (numout,*) '------------------------------' 
     138         IF (lwp) write (numout,*) 'Jpalm - debug' 
     139         IF (lwp) write (numout,*) ' in trc_init' 
     140         IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
     141         IF (lwp) write (numout,*) ' ' 
     142         CALL flush(numout) 
     143# endif 
     144 
     145 
     146      IF( ln_trcdta ) THEN 
     147#if defined key_medusa 
     148         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
     149         IF(lwp) CALL flush(numout) 
     150#endif 
     151         CALL trc_dta_init(jptra) 
     152      ENDIF 
    113153 
    114154      IF( ln_rsttr ) THEN 
    115155        ! 
     156#if defined key_medusa 
     157        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
     158        IF(lwp) CALL flush(numout) 
     159#endif 
    116160        CALL trc_rst_read              ! restart from a file 
    117161        ! 
    118162      ELSE 
     163        ! 
     164# if defined key_debug_medusa 
     165         IF (lwp) write (numout,*) '------------------------------' 
     166         IF (lwp) write (numout,*) 'Jpalm - debug' 
     167         IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 
     168         IF (lwp) write (numout,*) ' ' 
     169         CALL flush(numout) 
     170# endif 
    119171        ! 
    120172        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    … …  
    137189        ENDIF 
    138190        ! 
     191# if defined key_debug_medusa 
     192         IF (lwp) write (numout,*) '------------------------------' 
     193         IF (lwp) write (numout,*) 'Jpalm - debug' 
     194         IF (lwp) write (numout,*) ' in trc_init' 
     195         IF (lwp) write (numout,*) ' before trb = trn' 
     196         IF (lwp) write (numout,*) ' ' 
     197         CALL flush(numout) 
     198# endif 
     199        ! 
    139200        trb(:,:,:,:) = trn(:,:,:,:) 
     201        !  
     202# if defined key_debug_medusa 
     203         IF (lwp) write (numout,*) '------------------------------' 
     204         IF (lwp) write (numout,*) 'Jpalm - debug' 
     205         IF (lwp) write (numout,*) ' in trc_init' 
     206         IF (lwp) write (numout,*) ' trb = trn -- OK' 
     207         IF (lwp) write (numout,*) ' ' 
     208         CALL flush(numout) 
     209# endif 
    140210        !  
    141211      ENDIF 
    … …  
    146216      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    147217        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    148  
    149  
     218      ! 
     219# if defined key_debug_medusa 
     220         IF (lwp) write (numout,*) '------------------------------' 
     221         IF (lwp) write (numout,*) 'Jpalm - debug' 
     222         IF (lwp) write (numout,*) ' in trc_init' 
     223         IF (lwp) write (numout,*) ' partial step -- OK' 
     224         IF (lwp) write (numout,*) ' ' 
     225         CALL flush(numout) 
     226# endif 
    150227      ! 
    151228      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    152229      ! 
    153  
     230# if defined key_debug_medusa 
     231         IF (lwp) write (numout,*) '------------------------------' 
     232         IF (lwp) write (numout,*) 'Jpalm - debug' 
     233         IF (lwp) write (numout,*) ' in trc_init' 
     234         IF (lwp) write (numout,*) ' before initiate tracer contents' 
     235         IF (lwp) write (numout,*) ' ' 
     236         CALL flush(numout) 
     237# endif 
     238      ! 
    154239      trai(:) = 0._wp                                                   ! initial content of all tracers 
    155240      DO jn = 1, jptra 
    … …  
    164249         WRITE(numout,*) '          *** Total inital content of all tracers ' 
    165250         WRITE(numout,*) 
     251# if defined key_debug_medusa 
     252         CALL flush(numout) 
     253# endif 
     254         ! 
     255# if defined key_debug_medusa 
     256         WRITE(numout,*) ' litle check :  ', ctrcnm(1) 
     257         CALL flush(numout) 
     258# endif 
    166259         DO jn = 1, jptra 
    167260            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
    … …  
    176269         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    177270      ENDIF 
     271 
     272      IF(lwp) WRITE(numout,*) 
     273      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 
     274      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     275      IF(lwp) CALL flush(numout) 
     276# if defined key_debug_medusa 
     277         CALL trc_rst_stat 
     278         CALL flush(numout) 
     279# endif 
     280 
    1782819000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    179282      ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7203 r8280  
    1111   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 
    1212   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     13   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_top 
    … …  
    2526   USE trcnam_c14b       ! C14 SMS namelist 
    2627   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     28   USE trcnam_medusa     ! MEDUSA namelist 
     29   USE trcnam_idtra      ! Idealise tracer namelist 
     30   USE trcnam_age        ! AGE SMS namelist 
    2731   USE trd_oce        
    2832   USE trdtrc_oce 
    … …  
    5458      !! ** Method  : - read passive tracer namelist  
    5559      !!              - read namelist of each defined SMS model 
    56       !!                ( (PISCES, CFC, MY_TRC ) 
    57       !!--------------------------------------------------------------------- 
    58       INTEGER  ::   jn                  ! dummy loop indice 
     60      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 
     61      !!--------------------------------------------------------------------- 
     62      INTEGER  ::   jn, jk                     ! dummy loop indice 
    5963      !                                        !   Parameters of the run  
    6064      IF( .NOT. lk_offline ) CALL trc_nam_run 
    6165       
    6266      !                                        !  passive tracer informations 
     67# if defined key_debug_medusa 
     68      CALL flush(numout) 
     69      IF (lwp) write (numout,*) '------------------------------' 
     70      IF (lwp) write (numout,*) 'Jpalm - debug' 
     71      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 
     72      IF (lwp) write (numout,*) ' ' 
     73# endif 
     74      ! 
    6375      CALL trc_nam_trc 
    6476       
    6577      !                                        !   Parameters of additional diagnostics 
     78# if defined key_debug_medusa 
     79      CALL flush(numout) 
     80      IF (lwp) write (numout,*) '------------------------------' 
     81      IF (lwp) write (numout,*) 'Jpalm - debug' 
     82      IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 
     83      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 
     84      IF (lwp) write (numout,*) ' ' 
     85# endif 
     86      ! 
     87 
    6688      CALL trc_nam_dia 
    6789 
    6890      !                                        !   namelist of transport 
     91# if defined key_debug_medusa 
     92      CALL flush(numout) 
     93      IF (lwp) write (numout,*) '------------------------------' 
     94      IF (lwp) write (numout,*) 'Jpalm - debug' 
     95      IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 
     96      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 
     97      IF (lwp) write (numout,*) ' ' 
     98# endif 
     99      ! 
    69100      CALL trc_nam_trp 
     101      ! 
     102# if defined key_debug_medusa 
     103      CALL flush(numout) 
     104      IF (lwp) write (numout,*) '------------------------------' 
     105      IF (lwp) write (numout,*) 'Jpalm - debug' 
     106      IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 
     107      IF (lwp) write (numout,*) 'continue trc_nam ' 
     108      IF (lwp) write (numout,*) ' ' 
     109      CALL flush(numout) 
     110# endif 
     111      ! 
    70112 
    71113 
    … …  
    89131         END DO 
    90132         WRITE(numout,*) ' ' 
     133# if defined key_debug_medusa 
     134      CALL flush(numout) 
     135# endif 
    91136      ENDIF 
    92137 
    … …  
    107152            WRITE(numout,*) 
    108153         ENDIF 
    109       ENDIF 
    110  
     154# if defined key_debug_medusa 
     155      CALL flush(numout) 
     156# endif 
     157      ENDIF 
     158 
     159# if defined key_debug_medusa 
     160       DO jk = 1, jpk 
     161          WRITE(numout,*) '  level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 
     162       END DO 
     163      CALL flush(numout) 
     164# endif 
    111165       
    112166      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
    … …  
    116170        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    117171        WRITE(numout,*)  
     172# if defined key_debug_medusa 
     173      CALL flush(numout) 
     174# endif 
    118175      ENDIF 
    119176 
    … …  
    143200               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    144201            END DO 
     202         WRITE(numout,*) ' ' 
     203         CALL flush(numout) 
    145204         ENDIF 
    146205#endif 
    147206 
     207# if defined key_debug_medusa 
     208      CALL flush(numout) 
     209      IF (lwp) write (numout,*) '------------------------------' 
     210      IF (lwp) write (numout,*) 'Jpalm - debug' 
     211      IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 
     212      IF (lwp) write (numout,*) ' ' 
     213# endif 
     214      ! 
    148215 
    149216      ! Call the ice module for tracers 
    150217      ! ------------------------------- 
    151218      CALL trc_nam_ice 
     219 
     220# if defined key_debug_medusa 
     221      CALL flush(numout) 
     222      IF (lwp) write (numout,*) '------------------------------' 
     223      IF (lwp) write (numout,*) 'Jpalm - debug' 
     224      IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 
     225      IF (lwp) write (numout,*) ' ' 
     226# endif 
     227      ! 
    152228 
    153229      ! namelist of SMS 
    … …  
    156232      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    157233      ENDIF 
    158  
     234      ! 
     235# if defined key_debug_medusa 
     236      CALL flush(numout) 
     237      IF (lwp) write (numout,*) '------------------------------' 
     238      IF (lwp) write (numout,*) 'Jpalm - debug' 
     239      IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK' 
     240      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
     241      IF (lwp) write (numout,*) ' ' 
     242# endif 
     243      ! 
     244      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers 
     245      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used' 
     246      ENDIF 
     247      ! 
     248# if defined key_debug_medusa 
     249      CALL flush(numout) 
     250      IF (lwp) write (numout,*) '------------------------------' 
     251      IF (lwp) write (numout,*) 'Jpalm - debug' 
     252      IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 
     253      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 
     254      IF (lwp) write (numout,*) ' ' 
     255# endif 
     256      ! 
     257      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
     258      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
     259      ENDIF 
     260      ! 
     261# if defined key_debug_medusa 
     262      CALL flush(numout) 
     263      IF (lwp) write (numout,*) '------------------------------' 
     264      IF (lwp) write (numout,*) 'Jpalm - debug' 
     265      IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 
     266      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 
     267      IF (lwp) write (numout,*) ' ' 
     268# endif 
     269      ! 
    159270      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    160271      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    161272      ENDIF 
    162  
     273      ! 
     274# if defined key_debug_medusa 
     275      CALL flush(numout) 
     276      IF (lwp) write (numout,*) '------------------------------' 
     277      IF (lwp) write (numout,*) 'Jpalm - debug' 
     278      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
     279      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 
     280      IF (lwp) write (numout,*) ' ' 
     281# endif 
     282      ! 
    163283      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    164284      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    165285      ENDIF 
    166  
     286      ! 
     287# if defined key_debug_medusa 
     288      CALL flush(numout) 
     289      IF (lwp) write (numout,*) '------------------------------' 
     290      IF (lwp) write (numout,*) 'Jpalm - debug' 
     291      IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 
     292      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 
     293      IF (lwp) write (numout,*) ' ' 
     294# endif 
     295      ! 
     296      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     297      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     298      ENDIF 
     299      ! 
     300# if defined key_debug_medusa 
     301      CALL flush(numout) 
     302      IF (lwp) write (numout,*) '------------------------------' 
     303      IF (lwp) write (numout,*) 'Jpalm - debug' 
     304      IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 
     305      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 
     306      IF (lwp) write (numout,*) ' ' 
     307# endif 
     308      ! 
    167309      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    168310      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    169311      ENDIF 
    170       ! 
     312        
     313      IF(lwp)   CALL flush(numout) 
    171314   END SUBROUTINE trc_nam 
    172315 
    … …  
    216359         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    217360         WRITE(numout,*) ' ' 
     361        CALL flush(numout) 
    218362      ENDIF 
    219363      ! 
    … …  
    306450         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307451      END DO 
    308        
     452      IF(lwp)  CALL flush(numout)       
     453 
    309454    END SUBROUTINE trc_nam_trc 
    310455 
    … …  
    357502         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
    358503         WRITE(numout,*) ' ' 
    359       ENDIF 
    360  
    361       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     504         CALL flush(numout) 
     505      ENDIF 
     506!! 
     507!! JPALM -- 17-07-2015 -- 
     508!! MEDUSA is not yet up-to-date with the iom server. 
     509!! we use it for the main tracer, but not fully with diagnostics. 
     510!! will have to adapt it properly when visiting Christian Ethee 
     511!! for now, we change  
     512!! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
     513!! to : 
     514!! 
     515      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN  
    362516         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    363517           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
    … …  
    368522         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    369523         ! 
     524      !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 
     525      !!    CALL trc_nam_iom_medusa 
    370526      ENDIF 
    371527 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7203 r8280  
    2727   USE trcnam_trp 
    2828   USE iom 
     29   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2930   USE daymod 
     31   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 
     32   USE sms_medusa 
     33   USE trcsms_medusa 
     34   !! 
     35#if defined key_idtra 
     36   USE trcsms_idtra 
     37#endif 
     38   !! 
     39#if defined key_cfc 
     40   USE trcsms_cfc 
     41#endif 
     42   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE sbc_oce, ONLY: lk_oasis  
     44   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
     45 
    3046   IMPLICIT NONE 
    3147   PRIVATE 
    … …  
    3551   PUBLIC   trc_rst_wri       ! called by ??? 
    3652   PUBLIC   trc_rst_cal 
     53   PUBLIC   trc_rst_stat 
     54   PUBLIC   trc_rst_dia_stat 
     55   PUBLIC   trc_rst_tra_stat 
    3756 
    3857   !! * Substitutions 
    … …  
    4867      !!---------------------------------------------------------------------- 
    4968      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     69      INTEGER             ::   iyear, imonth, iday 
     70      REAL (wp)           ::   zsec 
     71      REAL (wp)           ::   zfjulday 
    5072      ! 
    5173      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    … …  
    78100      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    79101      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    80          ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    81          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    82          ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     102         IF ( ln_rstdate ) THEN 
     103            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 
     104            !!                     -- the condition to open the rst file is not the same than for the dynamic rst. 
     105            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process 
     106            !!                     instead of 1. 
     107            !!                     -- i am not sure if someone forgot +1 in the if loop condition as 
     108            !!                     it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is  
     109            !!                     nitrst - 2*nn_dttrc 
     110            !!                     -- nevertheless we didn't wanted to broke something already working  
     111            !!                     and just adapted the part we added. 
     112            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1))  
     113            !!                     we call ju2ymds( fjulday + (2*rdttra(1))  
     114            !!--------------------------------------------------------------------       
     115            zfjulday = fjulday + (2*rdttra(1)) / rday 
     116            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
     117            CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 
     118            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     119         ELSE 
     120            ! beware of the format used to write kt (default is i8.8, that should be large enough) 
     121            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     122            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     123            ENDIF 
    83124         ENDIF 
    84125         ! create the file 
    … …  
    101142      !! ** purpose  :   read passive tracer fields in restart files 
    102143      !!---------------------------------------------------------------------- 
    103       INTEGER  ::  jn      
     144      INTEGER  ::  jn, jl      
     145      !! AXY (05/11/13): temporary variables 
     146      REAL(wp) ::    fq0,fq1,fq2 
    104147 
    105148      !!---------------------------------------------------------------------- 
    … …  
    112155      DO jn = 1, jptra 
    113156         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     157         trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 
    114158      END DO 
    115159 
    116160      DO jn = 1, jptra 
    117161         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    118       END DO 
     162         trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 
     163      END DO 
     164      ! 
     165      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     166      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     167      !!                 version of NEMO date significantly earlier than the current 
     168      !!                 version 
     169 
     170#if defined key_medusa 
     171      !! AXY (13/01/12): check if the restart contains sediment fields; 
     172      !!                 this is only relevant for simulations that include 
     173      !!                 biogeochemistry and are restarted from earlier runs 
     174      !!                 in which there was no sediment component 
     175      !! 
     176      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 
     177         !! YES; in which case read them 
     178         !! 
     179         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 
     180         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  ) 
     181         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  ) 
     182         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 
     183         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 
     184         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 
     185         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 
     186         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  ) 
     187         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  ) 
     188         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 
     189         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 
     190      ELSE 
     191         !! NO; in which case set them to zero 
     192         !! 
     193         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 
     194         zb_sed_n(:,:)  = 0.0   !! organic N 
     195         zn_sed_n(:,:)  = 0.0 
     196         zb_sed_fe(:,:) = 0.0   !! organic Fe 
     197         zn_sed_fe(:,:) = 0.0 
     198         zb_sed_si(:,:) = 0.0   !! inorganic Si 
     199         zn_sed_si(:,:) = 0.0 
     200         zb_sed_c(:,:)  = 0.0   !! organic C 
     201         zn_sed_c(:,:)  = 0.0 
     202         zb_sed_ca(:,:) = 0.0   !! inorganic C 
     203         zn_sed_ca(:,:) = 0.0 
     204      ENDIF 
     205      !! 
     206      !! calculate stats on these fields 
     207      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     208      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     209      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     210      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     211      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     212      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     213      !! 
     214      !! AXY (07/07/15): read in temporally averaged fields for DMS 
     215      !!                 calculations 
     216      !! 
     217      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 
     218         !! YES; in which case read them 
     219         !! 
     220         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 
     221         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     222         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     223         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     224         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     225         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     226         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     227         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     228         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     229         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     230         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     231      ELSE 
     232         !! NO; in which case set them to zero 
     233         !! 
     234         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 
     235         zb_dms_chn(:,:)  = 0.0   !! CHN 
     236         zn_dms_chn(:,:)  = 0.0 
     237         zb_dms_chd(:,:)  = 0.0   !! CHD 
     238         zn_dms_chd(:,:)  = 0.0 
     239         zb_dms_mld(:,:)  = 0.0   !! MLD 
     240         zn_dms_mld(:,:)  = 0.0 
     241         zb_dms_qsr(:,:)  = 0.0   !! QSR 
     242         zn_dms_qsr(:,:)  = 0.0 
     243         zb_dms_din(:,:)  = 0.0   !! DIN 
     244         zn_dms_din(:,:)  = 0.0 
     245      ENDIF 
     246      !!   
     247      !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 
     248      !!                  -- needed for the coupling with atm 
     249      IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN 
     250         IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...' 
     251         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf',  zb_dms_srf(:,:)  ) 
     252         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf',  zn_dms_srf(:,:)  ) 
     253      ELSE 
     254         IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...' 
     255         zb_dms_srf(:,:)  = 0.0   !! DMS 
     256         zn_dms_srf(:,:)  = 0.0 
     257      ENDIF 
     258      IF (lk_oasis) THEN 
     259         DMS_out_cpl(:,:) = zn_dms_srf(:,:)        !! Coupling variable 
     260      END IF 
     261      !! 
     262      IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 
     263         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...' 
     264         CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx',  zb_co2_flx(:,:)  ) 
     265         CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx',  zn_co2_flx(:,:)  ) 
     266      ELSE 
     267         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...' 
     268         zb_co2_flx(:,:)  = 0.0   !! CO2 flx 
     269         zn_co2_flx(:,:)  = 0.0 
     270      ENDIF 
     271      IF (lk_oasis) THEN 
     272         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable 
     273      END IF 
     274      !! 
     275      !! JPALM 02-06-2017 -- in complement to DMS surf  
     276      !!                  -- the atm model needs surf Chl  
     277      !!                     as proxy of org matter from the ocean 
     278      !!                  -- needed for the coupling with atm 
     279      IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN 
     280         IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...' 
     281         CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf',  zn_chl_srf(:,:)  ) 
     282      ELSE 
     283         IF(lwp) WRITE(numout,*) 'Chl surf concentration - setting to zero ...' 
     284         zn_chl_srf(:,:)  = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 
     285      ENDIF 
     286      IF (lk_oasis) THEN 
     287         chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling variable 
     288      END IF 
     289      !! 
     290      !! calculate stats on these fields 
     291      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     292      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     293      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     294      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     295      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     296      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     297      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     298      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     299      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 
     300      !!   
     301      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     302      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     303# if defined key_roam 
     304      IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 
     305         IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 
     306         CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     307         CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     308         CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     309         CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     310         CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     311         CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     312         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     313         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     314         !! 
     315         IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     316      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     317      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     318      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     319      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     320      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     321      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     322      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     323      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     324 
     325      ELSE 
     326         IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 
     327         IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 
     328         IF(lwp) WRITE(numout,*) 'Check if   mod(kt*rdt,2592000) == rdt'  
     329         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'  
     330      ENDIF 
     331# endif 
     332 
     333 
     334#endif 
     335      ! 
     336#if defined key_idtra 
     337      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     338      !!                        writting here undre their key. 
     339      !!                        problems in CFC restart, maybe because of this... 
     340      !!                        and pb in idtra diag or diad-restart writing. 
     341      !!---------------------------------------------------------------------- 
     342      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 
     343         !! YES; in which case read them 
     344         !! 
     345         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 
     346         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  ) 
     347      ELSE 
     348         !! NO; in which case set them to zero 
     349         !! 
     350         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 
     351         qint_idtra(:,:,1)  = 0.0   !! CHN 
     352      ENDIF 
     353      !! 
     354      !! calculate stats on these fields 
     355      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     356      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     357#endif 
     358      ! 
     359#if defined key_cfc 
     360      DO jl = 1, jp_cfc 
     361         jn = jp_cfc0 + jl - 1 
     362         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 
     363            !! YES; in which case read them 
     364            !! 
     365            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 
     366            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     367         ELSE 
     368            !! NO; in which case set them to zero 
     369            !! 
     370            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 
     371            qint_cfc(:,:,jn)  = 0.0   !! CHN 
     372         ENDIF 
     373         !! 
     374         !! calculate stats on these fields 
     375         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     376         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     377      END DO 
     378#endif 
    119379      ! 
    120380   END SUBROUTINE trc_rst_read 
    … …  
    128388      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    129389      !! 
    130       INTEGER  :: jn 
     390      INTEGER  :: jn, jl 
    131391      REAL(wp) :: zarak0 
     392      !! AXY (05/11/13): temporary variables 
     393      REAL(wp) ::    fq0,fq1,fq2 
    132394      !!---------------------------------------------------------------------- 
    133395      ! 
    … …  
    142404         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    143405      END DO 
    144       ! 
     406 
     407      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     408      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     409      !!                 version of NEMO date significantly earlier than the current 
     410      !!                 version 
     411 
     412#if defined key_medusa 
     413      !! AXY (13/01/12): write out "before" and "now" state of seafloor 
     414      !!                 sediment pools into restart; this happens 
     415      !!                 whether or not the pools are to be used by 
     416      !!                 MEDUSA (which is controlled by a switch in the 
     417      !!                 namelist_top file) 
     418      !! 
     419      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 
     420      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  ) 
     421      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  ) 
     422      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 
     423      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 
     424      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 
     425      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 
     426      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  ) 
     427      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  ) 
     428      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 
     429      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 
     430      !! 
     431      !! calculate stats on these fields 
     432      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     433      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     434      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     435      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     436      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     437      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     438      !! 
     439      !! AXY (07/07/15): write out temporally averaged fields for DMS 
     440      !!                 calculations 
     441      !! 
     442      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 
     443      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     444      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     445      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     446      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     447      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     448      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     449      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     450      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     451      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     452      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     453         !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 
     454         !!                  -- needed for the coupling with atm 
     455      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf',  zb_dms_srf(:,:)  ) 
     456      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf',  zn_dms_srf(:,:)  ) 
     457      CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx',  zb_co2_flx(:,:)  ) 
     458      CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx',  zn_co2_flx(:,:)  ) 
     459      CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf',  zn_chl_srf(:,:)  ) 
     460      !! 
     461      !! calculate stats on these fields 
     462      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     463      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     464      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     465      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     466      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     467      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     468      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     469      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     470      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 
     471      !! 
     472      IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 
     473      call trc_rst_dia_stat(dust(:,:), 'Dust dep') 
     474      call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 
     475      !!  
     476      !!   
     477      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     478      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     479# if defined key_roam 
     480      IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 
     481      CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     482      CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     483      CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     484      CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     485      CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     486      CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     487      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     488      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     489      !! 
     490      IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     491      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     492      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     493      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     494      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     495      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     496      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     497      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     498      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     499      !! 
     500# endif 
     501!! 
     502#endif 
     503      ! 
     504#if defined key_idtra 
     505      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     506      !!                        writting here undre their key. 
     507      !!                        problems in CFC restart, maybe because of this... 
     508      !!                        and pb in idtra diag or diad-restart writing. 
     509      !!---------------------------------------------------------------------- 
     510      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 
     511      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) ) 
     512      !! 
     513      !! calculate stats on these fields 
     514      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     515      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     516#endif 
     517      ! 
     518#if defined key_cfc 
     519      DO jl = 1, jp_cfc 
     520         jn = jp_cfc0 + jl - 1 
     521         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 
     522         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     523         !! 
     524         !! calculate stats on these fields 
     525         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     526         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     527      END DO 
     528#endif 
     529      ! 
     530 
    145531      IF( kt == nitrst ) THEN 
    146532          CALL trc_rst_stat            ! statistics 
    … …  
    304690         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 
    305691      END DO 
    306       WRITE(numout,*)  
     692      IF(lwp) WRITE(numout,*)  
    3076939000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
    308694      &      '    max :',e18.10,'    drift :',e18.10, ' %') 
    309695      ! 
    310696   END SUBROUTINE trc_rst_stat 
     697 
     698 
     699   SUBROUTINE trc_rst_tra_stat 
     700      !!---------------------------------------------------------------------- 
     701      !!                    ***  trc_rst_tra_stat  *** 
     702      !! 
     703      !! ** purpose  :   Compute tracers statistics - check where crazy values appears 
     704      !!---------------------------------------------------------------------- 
     705      INTEGER  :: jk, jn 
     706      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 
     707      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     708      !!---------------------------------------------------------------------- 
     709 
     710      IF( lwp ) THEN 
     711         WRITE(numout,*) 
     712         WRITE(numout,*) '           ----SURFACE TRA STAT----             ' 
     713         WRITE(numout,*) 
     714      ENDIF 
     715      ! 
     716      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     717      areasf = glob_sum(zvol(:,:)) 
     718      DO jn = 1, jptra 
     719         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 
     720         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     721         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     722         IF( lk_mpp ) THEN 
     723            CALL mpp_min( zmin )      ! min over the global domain 
     724            CALL mpp_max( zmax )      ! max over the global domain 
     725         END IF 
     726         zmean  = ztraf / areasf 
     727         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 
     728      END DO 
     729      IF(lwp) WRITE(numout,*) 
     7309001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     731      &      '    max :',e18.10) 
     732      ! 
     733   END SUBROUTINE trc_rst_tra_stat 
     734 
     735 
     736 
     737   SUBROUTINE trc_rst_dia_stat( dgtr, names) 
     738      !!---------------------------------------------------------------------- 
     739      !!                    ***  trc_rst_dia_stat  *** 
     740      !! 
     741      !! ** purpose  :   Compute tracers statistics 
     742      !!---------------------------------------------------------------------- 
     743      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var 
     744      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name 
     745      !!--------------------------------------------------------------------- 
     746      INTEGER  :: jk, jn 
     747      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
     748      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     749      !!---------------------------------------------------------------------- 
     750 
     751      IF( lwp )  WRITE(numout,*) 'STAT- ', names 
     752      ! 
     753      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     754      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
     755      !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 
     756      areasf = glob_sum(zvol(:,:)) 
     757      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     758      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     759      IF( lk_mpp ) THEN 
     760         CALL mpp_min( zmin )      ! min over the global domain 
     761         CALL mpp_max( zmax )      ! max over the global domain 
     762      END IF 
     763      zmean  = ztraf / areasf 
     764      IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 
     765      ! 
     766      IF(lwp) WRITE(numout,*) 
     7679002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     768      &      '    max :',e18.10 ) 
     769      ! 
     770   END SUBROUTINE trc_rst_dia_stat 
     771 
    311772 
    312773#else 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r7203 r8280  
    1616   USE trc                ! 
    1717   USE trcsms_pisces      ! PISCES biogeo-model 
     18   USE trcsms_medusa      ! MEDUSA tracers 
     19   USE trcsms_idtra       ! Idealize Tracer 
    1820   USE trcsms_cfc         ! CFC 11 & 12 
    1921   USE trcsms_c14b        ! C14b tracer  
     22   USE trcsms_age         ! AGE tracer  
    2023   USE trcsms_my_trc      ! MY_TRC  tracers 
    2124   USE prtctl_trc         ! Print control for debbuging 
    … …  
    4346      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4447      !! 
     48      INTEGER            ::  jn 
    4549      CHARACTER (len=25) :: charout 
    4650      !!--------------------------------------------------------------------- 
    … …  
    4953      ! 
    5054      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     55      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
     56# if defined key_debug_medusa 
     57         IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- ' 
     58      CALL flush(numout) 
     59# endif 
     60      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
     61# if defined key_debug_medusa 
     62         IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- ' 
     63      CALL flush(numout) 
     64# endif 
    5165      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     66# if defined key_debug_medusa 
     67         IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  next C14 -- ' 
     68      CALL flush(numout) 
     69# endif 
    5270      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     71# if defined key_debug_medusa 
     72         IF(lwp) WRITE(numout,*) '--trcsms : C14 OK --  next C14 -- ' 
     73      CALL flush(numout) 
     74# endif 
     75      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
     76# if defined key_debug_medusa 
     77         IF(lwp) WRITE(numout,*) '--trcsms : Age OK --  Continue  -- ' 
     78      CALL flush(numout) 
     79# endif 
    5380      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    5481 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6487 r8280  
    5555      !!              Update the passive tracers 
    5656      !!------------------------------------------------------------------- 
     57 
     58      USE dom_oce, ONLY: narea 
     59 
    5760      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
    5861      INTEGER               ::  jk, jn  ! dummy loop indices 
    … …  
    8790         tra(:,:,:,:) = 0.e0 
    8891         ! 
     92# if defined key_debug_medusa 
     93         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
     94         CALL flush(numout) 
     95# endif 
    8996                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
     97# if defined key_debug_medusa 
     98                                   CALL trc_rst_stat  
     99                                   CALL trc_rst_tra_stat 
     100# endif 
    90101         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    91102         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    … …  
    93104         ENDIF 
    94105                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
     106# if defined key_debug_medusa 
     107         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 
     108         CALL trc_rst_stat 
     109         CALL trc_rst_tra_stat 
     110         CALL flush(numout) 
     111# endif 
    95112                                   CALL trc_trp      ( kt )       ! transport of passive tracers 
     113# if defined key_debug_medusa 
     114         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 
     115         CALL trc_rst_stat 
     116         CALL trc_rst_tra_stat 
     117         CALL flush(numout) 
     118# endif 
    96119         IF( kt == nittrc000 ) THEN 
    97120            CALL iom_close( numrtr )       ! close input tracer restart file 
    … …  
    102125         ! 
    103126         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    104          ! 
    105       ENDIF 
    106       ! 
    107       ztrai = 0._wp                                                   !  content of all tracers 
    108       DO jn = 1, jptra 
    109          ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    110       END DO 
    111       IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
    112 9300  FORMAT(i10,e18.10) 
     127# if defined key_debug_medusa 
     128         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
     129         CALL flush(numout) 
     130# endif 
     131         ! 
     132      ENDIF 
     133      ! 
     134      IF (ln_ctl) THEN  
     135         ! The following code is very expensive since it involves multiple  
     136         ! reproducible global sums over all tracer fields and is potentially   
     137         ! called on every timestep. The results it produces are purely for  
     138         ! informational purposes and do not affect model evolution.  
     139         ! Hence we restrict its use by protecting it with the ln_ctl RTL  
     140         ! which should normally only be used under debugging conditions  
     141         ! and not in operational runs. We also need to restrict output   
     142         ! to the master PE since there's no point duplicating the same results  
     143         ! on all processors.     
     144         ztrai = 0._wp                                                   !  content of all tracers 
     145         DO jn = 1, jptra 
     146            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     147         END DO 
     148         IF( numstr /= -1 ) WRITE(numstr,9300) kt,  ztrai / areatot 
     1499300     FORMAT(i10,e18.10) 
     150      ENDIF 
    113151      ! 
    114152      IF( nn_timing == 1 )   CALL timing_stop('trc_stp') 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r7203 r8280  
    55   !!====================================================================== 
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     7   !!              -   !  2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_top && defined key_iomput 
    … …  
    2122   USE trcwri_c14b 
    2223   USE trcwri_my_trc 
     24   USE trcwri_medusa 
     25   USE trcwri_idtra 
     26   USE trcwri_age 
    2327 
    2428   IMPLICIT NONE 
    … …  
    5761      ! --------------------------------------- 
    5862      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
     63      IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
     64      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
    5965      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6066      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     67      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6168      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    6269      ! 
Note: See TracChangeset for help on using the changeset viewer.