Changeset 4666 for branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

Timestamp:

2014-06-11T14:52:23+02:00 (10 years ago)

Author:

mathiot

Message:

#1331 : add ISOMIP config files + ice shelf code

File:

• branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90 (modified) (7 diffs)

branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

@@ -33 +33 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+   USE phycst
 
    IMPLICIT NONE
@@ -121 +122 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
       !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::   ierr             ! local integer
+      INTEGER  ::   ji, jj, jk, jn, ik   ! dummy loop indices
+      INTEGER  ::   ierr                 ! local integer
       REAL(wp) ::   zbtr, ztra                            ! local scalars
       REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      -
@@ -128 +129 @@
       REAL(wp) ::   zupsut, zcenut, zupst                 !   -      -
       REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez 
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez, zpress 
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind
       !!----------------------------------------------------------------------
@@ -134 +135 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2')
       !
-      CALL wrk_alloc( jpi, jpj, ztfreez )
+      CALL wrk_alloc( jpi, jpj, ztfreez, zpress )
       CALL wrk_alloc( jpi, jpj, jpk, zwz, zind )
       !
@@ -169 +170 @@
 !!gm  not strickly exact : the freezing point should be computed at each ocean levels...
 !!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
-      ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
+!!ch  changes for ice shelf to retain standard behaviour elsewhere, even if not optimal 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik=mikt(ji,jj) 
+            IF (ik > 1 ) THEN 
+               zpress(ji,jj) = grav*rau0*fsdept(ji,jj,ik)*1.e-04  
+            ELSE 
+               zpress(ji,jj) = 0.0 
+            ENDIF  
+         END DO 
+      END DO 
+      ztfreez(:,:) = tfreez( tsn(:,:,1, jp_sal), zpress(:,:) )
+      
       DO jk = 1, jpk
          DO jj = 1, jpj
@@ -224 +237 @@
          !                                                     ! Surface value : 
          IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
-         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! linear free surface 
+         ELSE
+            DO jj = 1, jpj   ! vector opt.
+               DO ji = 1, jpi   ! vector opt.
+                  ik=mikt(ji,jj)                
+                  zwz(ji,jj,ik ) = pwn(ji,jj,ik) * ptn(ji,jj,ik,jn)   ! linear free surface 
+                  zwz(ji,jj,1:ik-1) = 0.e0
+               END DO
+            END DO
          ENDIF
          !
@@ -281 +301 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, ztfreez )
+      CALL wrk_dealloc( jpi, jpj, ztfreez, zpress )
       CALL wrk_dealloc( jpi, jpj, jpk, zwz, zind )
       !