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 12590 for NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/tranpc.F90 – NEMO

Ignore:
Timestamp:
2020-03-23T22:16:19+01:00 (4 years ago)
Author:
techene
Message:

all: add e3 substitute, OCE/DOM/domzgr_substitute.h90: correct a bug for e3f

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/tranpc.F90

    r12377 r12590  
    3535   !! * Substitutions 
    3636#  include "do_loop_substitute.h90" 
     37#  include "domzgr_substitute.h90" 
    3738   !!---------------------------------------------------------------------- 
    3839   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7172      REAL(wp), DIMENSION(        jpk     )   ::   zvn2         ! vertical profile of N2 at 1 given point... 
    7273      REAL(wp), DIMENSION(        jpk,jpts)   ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk     )   ::   zn2          ! N^2  
     74      REAL(wp), DIMENSION(jpi,jpj,jpk     )   ::   zn2          ! N^2 
    7475      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)   ::   zab          ! alpha and beta 
    7576      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds ! 3D workspace 
     
    8687         IF( l_trdtra )   THEN                    !* Save initial after fields 
    8788            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    88             ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa)  
     89            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa) 
    8990            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa) 
    9091         ENDIF 
     
    9293         IF( l_LB_debug ) THEN 
    9394            ! Location of 1 known convection site to follow what's happening in the water column 
    94             ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...            
     95            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column... 
    9596            nncpu = 1  ;            ! the CPU domain contains the convection spot 
    96             klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
     97            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point... 
    9798         ENDIF 
    9899         ! 
     
    105106            ! 
    106107            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
    107                !                                     ! consider one ocean column  
     108               !                                     ! consider one ocean column 
    108109               zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa)      ! temperature 
    109110               zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa)      ! salinity 
    110111               ! 
    111                zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha  
    112                zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta   
    113                zvn2(:)         = zn2(ji,jj,:)            ! N^2  
     112               zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
     113               zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta 
     114               zvn2(:)         = zn2(ji,jj,:)            ! N^2 
    114115               ! 
    115116               IF( l_LB_debug ) THEN                  !LB debug: 
     
    117118                  IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE. 
    118119                  ! writing only if on CPU domain where conv region is: 
    119                   lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                       
     120                  lp_monitor_point = (narea == nncpu).AND.lp_monitor_point 
    120121               ENDIF                                  !LB debug  end 
    121122               ! 
     
    129130                  ! 
    130131                  jiter = jiter + 1 
    131                   !  
     132                  ! 
    132133                  IF( jiter >= 400 ) EXIT 
    133134                  ! 
     
    144145                        ilayer = ilayer + 1    ! yet another instable portion of the water column found.... 
    145146                        ! 
    146                         IF( lp_monitor_point ) THEN  
     147                        IF( lp_monitor_point ) THEN 
    147148                           WRITE(numout,*) 
    148149                           IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability 
     
    159160                        ENDIF 
    160161                        ! 
    161                         IF( jiter == 1 )   inpcc = inpcc + 1  
     162                        IF( jiter == 1 )   inpcc = inpcc + 1 
    162163                        ! 
    163164                        IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer 
     
    184185                        zsum_beta = 0._wp 
    185186                        zsum_z    = 0._wp 
    186                                                   
     187 
    187188                        DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column 
    188189                           ! 
     
    193194                           zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz 
    194195                           zsum_z    = zsum_z    + zdz 
    195                            !                               
     196                           ! 
    196197                           IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line 
    197198                           !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0): 
    198199                           IF( zvn2(jk+1) > zn2_zero ) EXIT 
    199200                        END DO 
    200                         
     201 
    201202                        ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2 
    202203                        IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2') 
     
    224225                           zvab(jk,jp_sal) = zbeta 
    225226                        END DO 
    226                          
    227                          
     227 
     228 
    228229                        !! Updating N2 in the relvant portion of the water column 
    229230                        !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 
    230231                        !! => Need to re-compute N2! will use Alpha and Beta! 
    231                          
     232 
    232233                        ikup   = MAX(2,ikup)         ! ikup can never be 1 ! 
    233234                        ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown! 
    234                          
     235 
    235236                        DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown! 
    236237 
     
    252253 
    253254                        END DO 
    254                       
     255 
    255256                        ikp = MIN(ikdown+1,ikbot) 
    256                          
     257 
    257258 
    258259                     ENDIF  !IF( zvn2(ikp) < 0. ) 
     
    264265 
    265266                  IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3') 
    266                   
     267 
    267268                  ! ******* At this stage ikp == ikbot ! ******* 
    268                   
     269 
    269270                  IF( ilayer > 0 ) THEN      !! least an unstable layer has been found 
    270271                     ! 
Note: See TracChangeset for help on using the changeset viewer.