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 10975 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90 – NEMO

Ignore:
Timestamp:
2019-05-13T18:34:33+02:00 (5 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Finish converting all TOP routines and knock-on effects of these conversions. Fully SETTE tested (SETTE tests 1-6 and 9). This completes the first stage conversion of TRA and TOP but need to revisit and pass ts and tr arrays through the argument lists where appropriate.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90

    r10966 r10975  
    4646CONTAINS 
    4747 
    48    SUBROUTINE p4z_sms( kt, Kbb, Kmm ) 
     48   SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                     ***  ROUTINE p4z_sms  *** 
     
    5858      !!--------------------------------------------------------------------- 
    5959      ! 
    60       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index       
    61       INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level index 
     60      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index       
     61      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level index 
    6262      !! 
    6363      INTEGER ::   ji, jj, jk, jnt, jn, jl 
     
    7373        ! 
    7474        IF( .NOT. ln_rsttr ) THEN 
    75             CALL p4z_che                              ! initialize the chemical constants 
    76             CALL ahini_for_at(hi)   !  set PH at kt=nit000 
     75            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     76            CALL ahini_for_at( hi, Kbb )              !  set PH at kt=nit000 
    7777            t_oce_co2_flx_cum = 0._wp 
    7878        ELSE 
    79             CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
     79            CALL p4z_rst( nittrc000, Kbb, Kmm,  'READ' )  !* read or initialize all required fields 
    8080        ENDIF 
    8181        ! 
    8282      ENDIF 
    8383      ! 
    84       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
     84      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt, Kbb, Kmm )      ! Relaxation of some tracers 
    8585      ! 
    8686      rfact = r2dttrc 
     
    9999      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
    100100         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    101             trb(:,:,:,jn) = trn(:,:,:,jn) 
     101            tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 
    102102         END DO 
    103103      ENDIF 
    104104      ! 
    105       IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
     105      IF( ll_sbc ) CALL p4z_sbc( kt, Kmm )   ! external sources of nutrients  
    106106      ! 
    107107#if ! defined key_sed_off 
    108       CALL p4z_che              ! computation of chemical constants 
    109       CALL p4z_int( kt )        ! computation of various rates for biogeochemistry 
     108      CALL p4z_che(     Kbb, Kmm       ) ! computation of chemical constants 
     109      CALL p4z_int( kt, Kbb, Kmm       ) ! computation of various rates for biogeochemistry 
    110110      ! 
    111111      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    112112         ! 
    113          CALL p4z_bio( kt, jnt, Kbb, Kmm )   ! Biology 
    114          CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation 
    115          CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions 
    116          CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
     113         CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs )   ! Biology 
     114         CALL p4z_lys( kt, jnt, Kbb,      Krhs )   ! Compute CaCO3 saturation 
     115         CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs )   ! Surface and Bottom boundary conditions 
     116         CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs )   ! Compute surface fluxes 
    117117         ! 
    118118         xnegtr(:,:,:) = 1.e0 
     
    121121               DO jj = 1, jpj 
    122122                  DO ji = 1, jpi 
    123                      IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    124                         ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
     123                     IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
     124                        ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
    125125                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    126126                     ENDIF 
     
    132132         !                                !  
    133133         DO jn = jp_pcs0, jp_pcs1 
    134            trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     134           tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 
    135135         END DO 
    136136        ! 
    137137         DO jn = jp_pcs0, jp_pcs1 
    138             tra(:,:,:,jn) = 0._wp 
     138            tr(:,:,:,jn,Krhs) = 0._wp 
    139139         END DO 
    140140         ! 
    141141         IF( ln_top_euler ) THEN 
    142142            DO jn = jp_pcs0, jp_pcs1 
    143                trn(:,:,:,jn) = trb(:,:,:,jn) 
     143               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    144144            END DO 
    145145         ENDIF 
     
    149149      IF( l_trdtrc ) THEN 
    150150         DO jn = jp_pcs0, jp_pcs1 
    151            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt, Kmm )   ! save trends 
     151           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    152152         END DO 
    153153      END IF 
     
    156156      IF( ln_sediment ) THEN  
    157157         ! 
    158          CALL sed_model( kt, Kmm )     !  Main program of Sediment model 
     158         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    159159         ! 
    160160         IF( ln_top_euler ) THEN 
    161161            DO jn = jp_pcs0, jp_pcs1 
    162                trn(:,:,:,jn) = trb(:,:,:,jn) 
     162               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    163163            END DO 
    164164         ENDIF 
     
    166166      ENDIF 
    167167      ! 
    168       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file  
    169       ! 
    170  
    171       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking 
    172  
    173       IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES 
     168      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
     169      ! 
     170 
     171      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 
     172 
     173      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )         ! flush output namelist PISCES 
    174174      ! 
    175175      IF( ln_timing )  CALL timing_stop('p4z_sms') 
     
    265265 
    266266 
    267    SUBROUTINE p4z_rst( kt, cdrw ) 
     267   SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 
    268268      !!--------------------------------------------------------------------- 
    269269      !!                   ***  ROUTINE p4z_rst  *** 
     
    276276      !!--------------------------------------------------------------------- 
    277277      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     278      INTEGER         , INTENT(in) ::   Kbb, Kmm   ! time level indices 
    278279      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    279280      !!--------------------------------------------------------------------- 
     
    288289            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    289290         ELSE 
    290             CALL p4z_che                              ! initialize the chemical constants 
    291             CALL ahini_for_at(hi) 
     291            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     292            CALL ahini_for_at( hi, Kbb ) 
    292293         ENDIF 
    293294         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
     
    336337 
    337338 
    338    SUBROUTINE p4z_dmp( kt ) 
     339   SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 
    339340      !!---------------------------------------------------------------------- 
    340341      !!                    ***  p4z_dmp  *** 
     
    343344      !!---------------------------------------------------------------------- 
    344345      ! 
    345       INTEGER, INTENT( in )  ::     kt ! time step 
     346      INTEGER, INTENT( in )  ::     kt            ! time step 
     347      INTEGER, INTENT( in )  ::     Kbb, Kmm      ! time level indices 
    346348      ! 
    347349      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
     
    364366            zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6               
    365367 
    366             zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    367             zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    368             zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    369             zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     368            zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:)  ) * zarea 
     369            zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:)  ) * zarea * po4r 
     370            zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:)  ) * zarea * rno3 
     371            zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:)  ) * zarea 
    370372  
    371373            IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
    372             trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
     374            tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 
    373375 
    374376            IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
    375             trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
     377            tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 
    376378 
    377379            IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
    378             trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
     380            tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 
    379381 
    380382            IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
    381             trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     383            tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 
    382384            ! 
    383385            ! 
    384386            IF( .NOT. ln_top_euler ) THEN 
    385                zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    386                zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    387                zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    388                zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     387               zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:)  ) * zarea 
     388               zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:)  ) * zarea * po4r 
     389               zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:)  ) * zarea * rno3 
     390               zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:)  ) * zarea 
    389391  
    390392               IF(lwp) WRITE(numout,*) ' ' 
    391393               IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
    392                trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
     394               tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 
    393395 
    394396               IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
    395                trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
     397               tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 
    396398 
    397399               IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
    398                trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
     400               tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 
    399401 
    400402               IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
    401                trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     403               tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 
    402404           ENDIF 
    403405        ENDIF 
     
    408410 
    409411 
    410    SUBROUTINE p4z_chk_mass( kt ) 
     412   SUBROUTINE p4z_chk_mass( kt, Kmm ) 
    411413      !!---------------------------------------------------------------------- 
    412414      !!                  ***  ROUTINE p4z_chk_mass  *** 
     
    416418      !!--------------------------------------------------------------------- 
    417419      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     420      INTEGER, INTENT( in ) ::   Kmm     ! time level indices 
    418421      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    419422      CHARACTER(LEN=100)   ::   cltxt 
     
    439442         !   Compute the budget of NO3, ALK, Si, Fer 
    440443         IF( ln_p4z ) THEN 
    441             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      & 
    442                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    443                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    444                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     444            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm)                      & 
     445               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     446               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     447               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    445448        ELSE 
    446             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   & 
    447                &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      &  
    448                &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   & 
    449                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3  
     449            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm)   & 
     450               &          +   tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm)                      &  
     451               &          +   tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm)   & 
     452               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3  
    450453        ENDIF 
    451454        ! 
     
    457460      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    458461         IF( ln_p4z ) THEN 
    459             zwork(:,:,:) =    trn(:,:,:,jppo4)                                         & 
    460                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    461                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    462                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     462            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm)                                         & 
     463               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     464               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     465               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    463466        ELSE 
    464             zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      & 
    465                &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      &  
    466                &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   & 
    467                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3  
     467            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm)                      & 
     468               &          +   tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm)                      &  
     469               &          +   tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm)   & 
     470               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3  
    468471        ENDIF 
    469472        ! 
     
    474477      ! 
    475478      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    476          zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)  
     479         zwork(:,:,:) =  tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)  
    477480         ! 
    478481         silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   
     
    482485      ! 
    483486      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    484          zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.               
     487         zwork(:,:,:) =  tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.               
    485488         ! 
    486489         alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         ! 
     
    490493      ! 
    491494      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    492          zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   & 
    493             &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      & 
    494             &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3     
     495         zwork(:,:,:) =   tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm)   & 
     496            &         +   tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm)                      & 
     497            &         + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) )  * ferat3     
    495498         ! 
    496499         ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   
Note: See TracChangeset for help on using the changeset viewer.