Changeset 5105 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

Timestamp:

2015-02-24T15:46:25+01:00 (9 years ago)

Author:

cbricaud

Message:

bug correction

File:

• branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90 (modified) (7 diffs)

branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

@@ -68 +68 @@
       INTEGER  :: ierr                                ! allocation error status
       INTEGER  ::   ios                 ! Local integer output status for namelist read
+      REAL(wp) :: zmin,zmax
       REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w
 
-      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
+      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn, ln_crs_top
       !!----------------------------------------------------------------------
       !
@@ -160 +161 @@
      CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
 
+     WHERE(e1t_crs == 0._wp) e1t_crs=r_inf
+     WHERE(e1u_crs == 0._wp) e1u_crs=r_inf
+     WHERE(e1v_crs == 0._wp) e1v_crs=r_inf
+     WHERE(e1f_crs == 0._wp) e1f_crs=r_inf
+     WHERE(e2t_crs == 0._wp) e2t_crs=r_inf
+     WHERE(e2u_crs == 0._wp) e2u_crs=r_inf
+     WHERE(e2v_crs == 0._wp) e2v_crs=r_inf
+     WHERE(e2f_crs == 0._wp) e2f_crs=r_inf
+
      e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
      
@@ -169 +179 @@
       CASE ( 0, 1, 4 )           ! mesh on the sphere
 
+         zmin=MINVAL(ABS(gphif_crs(:,:)));zmax=MAXVAL(ABS(gphif_crs(:,:)));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"gphif_crs",zmin,zmax
          ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
 
@@ -190 +201 @@
 
      !    3.d.2   Surfaces 
+     e2e3u_crs(:,:,:)=0._wp
+     e2e3u_msk(:,:,:)=0._wp
+     e1e3v_crs(:,:,:)=0._wp
+     e1e3v_msk(:,:,:)=0._wp
      CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    )
      WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1)
@@ -207 +222 @@
 
               facsurfu(ji,jj,jk) = umask_crs(ji,jj,jk) * e2e3u_msk(ji,jj,jk)  
-              IF( e2e3u_crs(ji,jj,jk) .NE. 0._wp ) facsurfu(ji,jj,jk) = facsurfu(ji,jj,jk) / e2e3u_crs(ji,jj,jk)
+
+              IF( facsurfu(ji,jj,jk) .NE. facsurfu(ji,jj,jk) )WRITE(narea+200,*)'BUG1',facsurfu(ji,jj,jk);call flush(narea+200)
+              IF( e2e3u_crs(ji,jj,jk) .NE. e2e3u_crs(ji,jj,jk) ) WRITE(narea+200,*)'BUG2',e2e3u_crs(ji,jj,jk);call flush(narea+200)
+              IF( e2e3u_msk(ji,jj,jk) .NE. e2e3u_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG3',e2e3u_msk(ji,jj,jk) ;call flush(narea+200)
+              IF( e1e2w_msk(ji,jj,jk) .NE. e1e2w_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',ji,jj,jk,e1e2w_msk(ji,jj,jk) ;call flush(narea+200)
+              IF( tmask(ji,jj,jk) .NE. tmask(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',tmask(ji,jj,jk) ;call flush(narea+200)
+              IF( e1t(ji,jj) .NE. e1t(ji,jj) ) WRITE(narea+200,*)'BUG5',e1t(ji,jj) ;call flush(narea+200)
+              IF( e1t(ji,jj) .NE. e2t(ji,jj) ) WRITE(narea+200,*)'BUG6',e2t(ji,jj) ;call flush(narea+200)
 
               facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk)  
@@ -224 +246 @@
      CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
      CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+     WHERE(e3t_max_crs == 0._wp) e3t_max_crs=r_inf
+     WHERE(e3u_max_crs == 0._wp) e3u_max_crs=r_inf
+     WHERE(e3v_max_crs == 0._wp) e3v_max_crs=r_inf
+     WHERE(e3w_max_crs == 0._wp) e3w_max_crs=r_inf
 
      ! Reset 0 to e3t_0 or e3w_0
@@ -264 +290 @@
         CALL dom_grid_glo   ! Return to parent grid domain
      ENDIF
-     
+    
+
+      rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp
+
+ 
      !---------------------------------------------------------
      ! 7. Finish and clean-up