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

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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      ! 
Note: See TracChangeset for help on using the changeset viewer.