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 5707 – NEMO

Changeset 5707


Ignore:
Timestamp:
2015-08-26T14:18:46+02:00 (9 years ago)
Author:
acc
Message:

JPALM --25-08-2015 -- add MEDUSA in the branch. MEDUSA version already up-to-date with this trunk revision

Location:
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC
Files:
22 added
6 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r4529 r5707  
    1515   USE par_cfc       ! CFC 11 and 12 tracers 
    1616   USE par_my_trc    ! user defined passive tracers 
     17   USE par_medusa    ! MEDUSA model 
     18   USE par_idtra     ! Idealize tracer 
    1719 
    1820   IMPLICIT NONE 
     
    2426   ! Passive tracers : Total size 
    2527   ! ---------------               ! 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 
     28   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra 
     29   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d 
     30   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d 
    2931   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     32   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd 
    3133    
    3234   !  1D configuration ("key_c1d") 
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r4990 r5707  
    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 
    2629   USE trcdta          ! initialisation from files 
    2730   USE daymod          ! calendar manager 
     
    3134   USE lib_mpp         ! distribued memory computing library 
    3235   USE sbc_oce 
     36   USE lib_fortran     ! glob_sum 
     37 
    3338  
    3439   IMPLICIT NONE 
     
    6166      CHARACTER (len=25) :: charout 
    6267      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
     68# if defined key_debug_medusa 
     69      !!INTEGER  ::  globmask                             ! glob_sum tests for debug 
     70      REAL(wp) ::  globtr, globvl, globtrvol, globmask  ! glob_sum tests for debug  
     71# endif 
     72 
     73 
    6374      !!--------------------------------------------------------------------- 
    6475      ! 
     
    7586#endif 
    7687 
     88    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     89    !!!!! CHECK For MEDUSA 
     90    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    7791      IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 
    7892 
     
    100114      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    101115      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     116      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
     117      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
     118 
     119# if defined key_debug_medusa 
     120         IF (lwp) write (numout,*) '------------------------------' 
     121         IF (lwp) write (numout,*) 'Jpalm - debug' 
     122         IF (lwp) write (numout,*) ' in trc_init' 
     123         IF (lwp) write (numout,*) ' sms init OK' 
     124         IF (lwp) write (numout,*) ' next: open tracer.stat' 
     125         IF (lwp) write (numout,*) ' ' 
     126         CALL flush(numout) 
     127# endif 
    102128 
    103129      IF( lwp ) THEN 
     
    107133      ENDIF 
    108134 
    109       IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    110  
     135# if defined key_debug_medusa 
     136         IF (lwp) write (numout,*) '------------------------------' 
     137         IF (lwp) write (numout,*) 'Jpalm - debug' 
     138         IF (lwp) write (numout,*) ' in trc_init' 
     139         IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
     140         IF (lwp) write (numout,*) ' ' 
     141         CALL flush(numout) 
     142# endif 
     143 
     144 
     145      IF( ln_trcdta ) THEN 
     146#if defined key_medusa 
     147         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
     148         IF(lwp) CALL flush(numout) 
     149#endif 
     150         CALL trc_dta_init(jptra) 
     151      ENDIF 
    111152 
    112153      IF( ln_rsttr ) THEN 
    113154        ! 
     155#if defined key_medusa 
     156        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
     157        IF(lwp) CALL flush(numout) 
     158#endif 
    114159        CALL trc_rst_read              ! restart from a file 
    115160        ! 
     
    118163        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    119164            ! 
     165#if defined key_medusa 
     166            IF(lwp) WRITE(numout,*) 'AXY: calling wrk_alloc' 
     167            IF(lwp) CALL flush(numout) 
     168#endif 
    120169            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    121170            ! 
     171#if defined key_medusa 
     172            IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta' 
     173            IF(lwp) CALL flush(numout) 
     174#endif 
    122175            DO jn = 1, jptra 
    123176               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     
    126179                  ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    127180                  trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)   
    128                   IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
     181                  IF( .NOT.ln_trcdmp .AND. .NOT. ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
    129182                     !                                                    (data used only for initialisation) 
    130183                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 
     
    135188               ENDIF 
    136189            ENDDO 
     190#if defined key_medusa 
     191            IF(lwp) WRITE(numout,*) 'AXY: calling wrk_dealloc' 
     192            IF(lwp) CALL flush(numout) 
     193#endif 
    137194            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    138195        ENDIF 
    139196        ! 
     197# if defined key_debug_medusa 
     198         IF (lwp) write (numout,*) '------------------------------' 
     199         IF (lwp) write (numout,*) 'Jpalm - debug' 
     200         IF (lwp) write (numout,*) ' in trc_init' 
     201         IF (lwp) write (numout,*) ' before trb = trn' 
     202         IF (lwp) write (numout,*) ' ' 
     203         CALL flush(numout) 
     204# endif 
     205        ! 
    140206        trb(:,:,:,:) = trn(:,:,:,:) 
     207        !  
     208# if defined key_debug_medusa 
     209         IF (lwp) write (numout,*) '------------------------------' 
     210         IF (lwp) write (numout,*) 'Jpalm - debug' 
     211         IF (lwp) write (numout,*) ' in trc_init' 
     212         IF (lwp) write (numout,*) ' trb = trn -- OK' 
     213         IF (lwp) write (numout,*) ' ' 
     214         CALL flush(numout) 
     215# endif 
    141216        !  
    142217      ENDIF 
     
    145220      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    146221        &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level 
    147  
     222      ! 
     223# if defined key_debug_medusa 
     224         IF (lwp) write (numout,*) '------------------------------' 
     225         IF (lwp) write (numout,*) 'Jpalm - debug' 
     226         IF (lwp) write (numout,*) ' in trc_init' 
     227         IF (lwp) write (numout,*) ' partial step -- OK' 
     228         IF (lwp) write (numout,*) ' ' 
     229         CALL flush(numout) 
     230# endif 
    148231      ! 
    149232      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    150233      ! 
    151  
     234# if defined key_debug_medusa 
     235         IF (lwp) write (numout,*) '------------------------------' 
     236         IF (lwp) write (numout,*) 'Jpalm - debug' 
     237         IF (lwp) write (numout,*) ' in trc_init' 
     238         IF (lwp) write (numout,*) ' before initiate tracer contents' 
     239         IF (lwp) write (numout,*) ' ' 
     240         CALL flush(numout) 
     241# endif 
     242      ! 
     243# if defined key_debug_medusa 
     244         write (*,*) narea,' TRCINI ','Jpalm - debug' 
     245         write (*,*) narea,' TRCINI ','LN_CTL = TRUE ' 
     246         write (*,*) narea,' TRCINI ','---------------------------------' 
     247      CALL flush(numout) 
     248      globmask  = glob_sum( tmask(:,:,:)) 
     249      IF (lwp) write (numout,*) 'glob_sum test, sum tmask : ',globmask   
     250# endif 
     251      ! 
    152252      trai(:) = 0._wp                                                   ! initial content of all tracers 
    153253      DO jn = 1, jptra 
     254# if defined key_debug_medusa 
     255         globtr    = glob_sum( trn(:,:,:,jn)) 
     256         globvl    = glob_sum( cvol(:,:,:)) 
     257         globtrvol = glob_sum( trn(:,:,:,jn) * cvol(:,:,:))  
     258         ! 
     259         IF (lwp) write (numout,*) 'var number : ',jn 
     260         CALL flush(numout) 
     261         IF (lwp) write (numout,*) 'trai(jn) before - should be 0 - ',trai(jn) 
     262         CALL flush(numout) 
     263         IF (lwp) write (numout,*) 'global Ocean volume  :          ',globvl 
     264         CALL flush(numout) 
     265         IF (lwp) write (numout,*) 'global sum of tracer :          ',globtr 
     266         CALL flush(numout) 
     267         IF (lwp) write (numout,*) 'global weighted tracer  :       ',globtrvol 
     268         CALL flush(numout) 
     269# endif 
    154270         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    155271      END DO 
     
    162278         WRITE(numout,*) '          *** Total inital content of all tracers ' 
    163279         WRITE(numout,*) 
     280# if defined key_debug_medusa 
     281         CALL flush(numout) 
     282# endif 
     283         ! 
     284# if defined key_debug_medusa 
     285         WRITE(numout,*) ' litle check :  ', ctrcnm(1) 
     286         CALL flush(numout) 
     287# endif 
    164288         DO jn = 1, jptra 
    165289            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     
    174298         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    175299      ENDIF 
     300 
     301      IF(lwp) WRITE(numout,*) 
     302      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 
     303      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     304      IF(lwp) CALL flush(numout) 
     305 
    1763069000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    177307      ! 
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4990 r5707  
    2525   USE trcnam_c14b       ! C14 SMS namelist 
    2626   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     27   USE trcnam_medusa     ! MEDUSA namelist 
     28   USE trcnam_idtra      ! Idealise tracer namelist 
    2729   USE trd_oce        
    2830   USE trdtrc_oce 
     
    5658      !!                ( (PISCES, CFC, MY_TRC ) 
    5759      !!--------------------------------------------------------------------- 
    58       INTEGER  ::   jn                  ! dummy loop indice 
     60      INTEGER  ::   jn, jk                     ! dummy loop indice 
    5961      !                                        !   Parameters of the run  
    6062      IF( .NOT. lk_offline ) CALL trc_nam_run 
    6163       
    6264      !                                        !  passive tracer informations 
     65# if defined key_debug_medusa 
     66      CALL flush(numout) 
     67      IF (lwp) write (numout,*) '------------------------------' 
     68      IF (lwp) write (numout,*) 'Jpalm - debug' 
     69      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 
     70      IF (lwp) write (numout,*) ' ' 
     71# endif 
     72      ! 
    6373      CALL trc_nam_trc 
    6474       
    6575      !                                        !   Parameters of additional diagnostics 
     76# if defined key_debug_medusa 
     77      CALL flush(numout) 
     78      IF (lwp) write (numout,*) '------------------------------' 
     79      IF (lwp) write (numout,*) 'Jpalm - debug' 
     80      IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 
     81      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 
     82      IF (lwp) write (numout,*) ' ' 
     83# endif 
     84      ! 
     85 
    6686      CALL trc_nam_dia 
    6787 
    6888      !                                        !   namelist of transport 
     89# if defined key_debug_medusa 
     90      CALL flush(numout) 
     91      IF (lwp) write (numout,*) '------------------------------' 
     92      IF (lwp) write (numout,*) 'Jpalm - debug' 
     93      IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 
     94      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 
     95      IF (lwp) write (numout,*) ' ' 
     96# endif 
     97      ! 
    6998      CALL trc_nam_trp 
     99      ! 
     100# if defined key_debug_medusa 
     101      CALL flush(numout) 
     102      IF (lwp) write (numout,*) '------------------------------' 
     103      IF (lwp) write (numout,*) 'Jpalm - debug' 
     104      IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 
     105      IF (lwp) write (numout,*) 'continue trc_nam ' 
     106      IF (lwp) write (numout,*) ' ' 
     107      CALL flush(numout) 
     108# endif 
     109      ! 
    70110 
    71111 
     
    89129         END DO 
    90130         WRITE(numout,*) ' ' 
     131# if defined key_debug_medusa 
     132      CALL flush(numout) 
     133# endif 
    91134      ENDIF 
    92135 
     
    107150            WRITE(numout,*) 
    108151         ENDIF 
    109       ENDIF 
    110  
     152# if defined key_debug_medusa 
     153      CALL flush(numout) 
     154# endif 
     155      ENDIF 
     156 
     157# if defined key_debug_medusa 
     158       DO jk = 1, jpk 
     159          WRITE(numout,*) '  level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 
     160       END DO 
     161      CALL flush(numout) 
     162# endif 
    111163       
    112164      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
     
    116168        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    117169        WRITE(numout,*)  
     170# if defined key_debug_medusa 
     171      CALL flush(numout) 
     172# endif 
    118173      ENDIF 
    119174 
     
    143198               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    144199            END DO 
     200         WRITE(numout,*) ' ' 
     201         CALL flush(numout) 
    145202         ENDIF 
    146203#endif 
    147204 
     205# if defined key_debug_medusa 
     206      CALL flush(numout) 
     207      IF (lwp) write (numout,*) '------------------------------' 
     208      IF (lwp) write (numout,*) 'Jpalm - debug' 
     209      IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 
     210      IF (lwp) write (numout,*) ' ' 
     211# endif 
     212      ! 
    148213 
    149214      ! namelist of SMS 
     
    152217      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    153218      ENDIF 
    154  
     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,*) 'CALL trc_nam_pisces -- OK' 
     225      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
     226      IF (lwp) write (numout,*) ' ' 
     227# endif 
     228      ! 
     229      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers 
     230      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used' 
     231      ENDIF 
     232      ! 
     233# if defined key_debug_medusa 
     234      CALL flush(numout) 
     235      IF (lwp) write (numout,*) '------------------------------' 
     236      IF (lwp) write (numout,*) 'Jpalm - debug' 
     237      IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 
     238      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 
     239      IF (lwp) write (numout,*) ' ' 
     240# endif 
     241      ! 
     242      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
     243      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
     244      ENDIF 
     245      ! 
     246# if defined key_debug_medusa 
     247      CALL flush(numout) 
     248      IF (lwp) write (numout,*) '------------------------------' 
     249      IF (lwp) write (numout,*) 'Jpalm - debug' 
     250      IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 
     251      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 
     252      IF (lwp) write (numout,*) ' ' 
     253# endif 
     254      ! 
    155255      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    156256      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    157257      ENDIF 
    158  
     258      ! 
     259# if defined key_debug_medusa 
     260      CALL flush(numout) 
     261      IF (lwp) write (numout,*) '------------------------------' 
     262      IF (lwp) write (numout,*) 'Jpalm - debug' 
     263      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
     264      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14b' 
     265      IF (lwp) write (numout,*) ' ' 
     266# endif 
     267      ! 
    159268      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    160269      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     
    165274      ENDIF 
    166275      ! 
     276      IF(lwp)   CALL flush(numout) 
    167277   END SUBROUTINE trc_nam 
    168278 
     
    211321         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    212322         WRITE(numout,*) ' ' 
     323        CALL flush(numout) 
    213324      ENDIF 
    214325      ! 
     
    251362         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    252363      END DO 
    253        
     364      IF(lwp)  CALL flush(numout)       
     365 
    254366    END SUBROUTINE trc_nam_trc 
    255367 
     
    302414         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
    303415         WRITE(numout,*) ' ' 
    304       ENDIF 
    305  
    306       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     416         CALL flush(numout) 
     417      ENDIF 
     418!! 
     419!! JPALM -- 17-07-2015 -- 
     420!! MEDUSA is not yet up-to-date with the iom server. 
     421!! we use it for the main tracer, but not fully with diagnostics. 
     422!! will have to adapt it properly when visiting Christian Ethee 
     423!! for now, we change  
     424!! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
     425!! to : 
     426!! 
     427      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN  
    307428         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    308429           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4990 r5707  
    2828   USE iom 
    2929   USE daymod 
     30   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 
     31   USE sms_medusa 
     32   USE trcsms_medusa 
     33   !! 
    3034   IMPLICIT NONE 
    3135   PRIVATE 
     
    8892   SUBROUTINE trc_rst_read 
    8993      !!---------------------------------------------------------------------- 
    90       !!                    ***  trc_rst_opn  *** 
     94      !!                    ***  trc_read_opn  *** 
    9195      !! 
    9296      !! ** purpose  :   read passive tracer fields in restart files 
    9397      !!---------------------------------------------------------------------- 
    9498      INTEGER  ::  jn      
     99      !! AXY (05/11/13): temporary variables 
     100      REAL(wp) ::    fq0,fq1,fq2 
    95101 
    96102      !!---------------------------------------------------------------------- 
     
    108114         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    109115      END DO 
     116 
     117      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     118      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     119      !!                 version of NEMO date significantly earlier than the current 
     120      !!                 version 
     121 
     122#if defined key_medusa 
     123      !! AXY (13/01/12): check if the restart contains sediment fields; 
     124      !!                 this is only relevant for simulations that include 
     125      !!                 biogeochemistry and are restarted from earlier runs 
     126      !!                 in which there was no sediment component 
     127      !! 
     128      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 
     129         !! YES; in which case read them 
     130         !! 
     131         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 
     132         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  ) 
     133         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  ) 
     134         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 
     135         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 
     136         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 
     137         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 
     138         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  ) 
     139         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  ) 
     140         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 
     141         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 
     142      ELSE 
     143         !! NO; in which case set them to zero 
     144         !! 
     145         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 
     146         zb_sed_n(:,:)  = 0.0   !! organic N 
     147         zn_sed_n(:,:)  = 0.0 
     148         zb_sed_fe(:,:) = 0.0   !! organic Fe 
     149         zn_sed_fe(:,:) = 0.0 
     150         zb_sed_si(:,:) = 0.0   !! inorganic Si 
     151         zn_sed_si(:,:) = 0.0 
     152         zb_sed_c(:,:)  = 0.0   !! organic C 
     153         zn_sed_c(:,:)  = 0.0 
     154         zb_sed_ca(:,:) = 0.0   !! inorganic C 
     155         zn_sed_ca(:,:) = 0.0 
     156      ENDIF 
     157      !! 
     158      !! calculate stats on these fields 
     159      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     160      fq0 = MINVAL(zn_sed_n(:,:)) 
     161      fq1 = MAXVAL(zn_sed_n(:,:)) 
     162      fq2 = SUM(zn_sed_n(:,:)) 
     163      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', & 
     164         &        fq0, fq1, fq2 
     165      fq0 = MINVAL(zn_sed_fe(:,:)) 
     166      fq1 = MAXVAL(zn_sed_fe(:,:)) 
     167      fq2 = SUM(zn_sed_fe(:,:)) 
     168      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 
     169         &        fq0, fq1, fq2 
     170      fq0 = MINVAL(zn_sed_si(:,:)) 
     171      fq1 = MAXVAL(zn_sed_si(:,:)) 
     172      fq2 = SUM(zn_sed_si(:,:)) 
     173      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 
     174         &        fq0, fq1, fq2 
     175      fq0 = MINVAL(zn_sed_c(:,:)) 
     176      fq1 = MAXVAL(zn_sed_c(:,:)) 
     177      fq2 = SUM(zn_sed_c(:,:)) 
     178      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', & 
     179         &        fq0, fq1, fq2 
     180      fq0 = MINVAL(zn_sed_ca(:,:)) 
     181      fq1 = MAXVAL(zn_sed_ca(:,:)) 
     182      fq2 = SUM(zn_sed_ca(:,:)) 
     183      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 
     184         &        fq0, fq1, fq2 
     185#endif 
     186  
    110187      ! 
    111188   END SUBROUTINE trc_rst_read 
     
    121198      INTEGER  :: jn 
    122199      REAL(wp) :: zarak0 
     200      !! AXY (05/11/13): temporary variables 
     201      REAL(wp) ::    fq0,fq1,fq2 
    123202      !!---------------------------------------------------------------------- 
    124203      ! 
     
    133212         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    134213      END DO 
     214 
     215      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     216      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     217      !!                 version of NEMO date significantly earlier than the current 
     218      !!                 version 
     219 
     220#if defined key_medusa 
     221      !! AXY (13/01/12): write out "before" and "now" state of seafloor 
     222      !!                 sediment pools into restart; this happens 
     223      !!                 whether or not the pools are to be used by 
     224      !!                 MEDUSA (which is controlled by a switch in the 
     225      !!                 namelist_top file) 
     226      !! 
     227      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 
     228      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  ) 
     229      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  ) 
     230      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 
     231      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 
     232      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 
     233      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 
     234      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  ) 
     235      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  ) 
     236      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 
     237      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 
     238      !! 
     239      !! calculate stats on these fields 
     240      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     241      fq0 = MINVAL(zn_sed_n(:,:)) 
     242      fq1 = MAXVAL(zn_sed_n(:,:)) 
     243      fq2 = SUM(zn_sed_n(:,:)) 
     244      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', & 
     245         &        fq0, fq1, fq2 
     246      fq0 = MINVAL(zn_sed_fe(:,:)) 
     247      fq1 = MAXVAL(zn_sed_fe(:,:)) 
     248      fq2 = SUM(zn_sed_fe(:,:)) 
     249      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 
     250         &        fq0, fq1, fq2 
     251      fq0 = MINVAL(zn_sed_si(:,:)) 
     252      fq1 = MAXVAL(zn_sed_si(:,:)) 
     253      fq2 = SUM(zn_sed_si(:,:)) 
     254      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 
     255         &        fq0, fq1, fq2 
     256      fq0 = MINVAL(zn_sed_c(:,:)) 
     257      fq1 = MAXVAL(zn_sed_c(:,:)) 
     258      fq2 = SUM(zn_sed_c(:,:)) 
     259      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', & 
     260         &        fq0, fq1, fq2 
     261      fq0 = MINVAL(zn_sed_ca(:,:)) 
     262      fq1 = MAXVAL(zn_sed_ca(:,:)) 
     263      fq2 = SUM(zn_sed_ca(:,:)) 
     264      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 
     265         &        fq0, fq1, fq2 
     266#endif 
     267 
    135268      ! 
    136269      IF( kt == nitrst ) THEN 
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r3680 r5707  
    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  
     
    4951      ! 
    5052      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     53      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
     54      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
    5155      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    5256      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
  • branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4990 r5707  
    8888         tra(:,:,:,:) = 0.e0 
    8989         ! 
     90# if defined key_debug_medusa 
     91         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
     92         CALL flush(numout) 
     93# endif 
    9094                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    9195         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
     
    9498         ENDIF 
    9599                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
     100# if defined key_debug_medusa 
     101         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 
     102         CALL flush(numout) 
     103# endif 
    96104                                   CALL trc_trp      ( kt )       ! transport of passive tracers 
     105# if defined key_debug_medusa 
     106         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 
     107         CALL flush(numout) 
     108# endif 
    97109         IF( kt == nittrc000 ) THEN 
    98110            CALL iom_close( numrtr )       ! close input tracer restart file 
     
    103115         ! 
    104116         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
     117# if defined key_debug_medusa 
     118         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
     119         CALL flush(numout) 
     120# endif 
    105121         ! 
    106122      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.