Changeset 3414 for branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

Timestamp:

2012-06-15T14:53:43+02:00 (12 years ago)

Author:

acc

Message:

Branch: dev_r3385_NOCS04_HAMF; #665. Stage 3 of 2012 development: First working version with (optionally) active embedding. Still some stability questions when running the LIM2-EVP, ORCA2 test-case with full embedding. Works with reduced (halved) timestep. Still investigating.

File:

• branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90 (modified) (6 diffs)

branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

@@ -30 +30 @@
    USE in_out_manager ! I/O manager
    USE prtctl         ! Print control
+   USE oce, ONLY : snwice_mass, snwice_mass_b
 
    IMPLICIT NONE
@@ -80 +81 @@
       REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22
       REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22
+      REAL(wp) ::   zintb, zintn
       REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld, zmass, zcorl
       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct, za2ct, zresr
       REAL(wp), POINTER, DIMENSION(:,:) ::   zc1u, zc1v, zc2u, zc2v
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zsang
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsang, zpice
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu0, zv0
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_n, zv_n
@@ -93 +95 @@
       
       CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
-      CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )
+      CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
       CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
       CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
@@ -129 +131 @@
 !i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp
 
+      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
 
       ! Ice mass, ice strength, and wind stress at the center            |
@@ -196 +214 @@
 
             ! Gradient of the sea surface height
-            zgsshx =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   &
-               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
-            zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   &
-               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
+            zgsshx =  (   (zpice(ji  ,jj  ) - zpice(ji-1,jj  ))/e1u(ji-1,jj  )   &
+               &       +  (zpice(ji  ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
+            zgsshy =  (   (zpice(ji  ,jj  ) - zpice(ji  ,jj-1))/e2v(ji  ,jj-1)   &
+               &       +  (zpice(ji-1,jj  ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
 
             ! Computation of the velocity field taking into account the ice-ice interaction.                                 
@@ -575 +593 @@
 
       CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
-      CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )
+      CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
       CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
       CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )