Changeset 5010 for branches/2015/dev_r5003_MERCATOR6_CRS

Timestamp:

2015-01-06T08:59:28+01:00 (8 years ago)

Author:

cbricaud

Message:

second modifications for output coarsening . see ticket 1426

Location:

branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC

Files:

• CRS/crs.F90 (modified) (9 diffs)
• CRS/crsdom.F90 (modified) (5 diffs)
• CRS/crsfld.F90 (modified) (2 diffs)
• LBC/mppini.F90 (modified) (1 diff)

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

@@ -10 +10 @@
    USE dom_oce
    USE in_out_manager
-
+   USE lbcnfd
 
    IMPLICIT NONE
@@ -72 +72 @@
       INTEGER ::   nproc_crs                   !:number for local processor
       INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
-      
+     
+      INTEGER ::  nfsloop_full,nfeloop_full 
+      INTEGER ::  nfsloop_crs ,nfeloop_crs
 
       INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
@@ -88 +90 @@
       INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain
 
+      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_full
+      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_crs
  
       ! Masks
@@ -259 +263 @@
       !!-------------------------------------------------------------------
       !! Local variables
-      INTEGER, DIMENSION(1) :: ierr
+      INTEGER, DIMENSION(2) :: ierr
 
       ierr(:) = 0
@@ -268 +272 @@
        &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(1) )
 
+      ALLOCATE( nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) ,STAT=ierr(2) )
+
       crs_dom_alloc = MAXVAL(ierr)
 
@@ -296 +302 @@
       !! ** Purpose : +Return back to parent grid domain 
       !!---------------------------------------------------------------------
+      write(narea+200,*)"dom_grid_glo";call flush(narea+200)
 
       !                         Return to parent grid domain
@@ -326 +333 @@
       njmppt(:) = njmppt_full(:)
 
+      nfsloop = nfsloop_full
+      nfeloop = nfeloop_full
+
+      nfiimpp(:,:) = nfiimpp_full(:,:)
+
    END SUBROUTINE dom_grid_glo
 
@@ -334 +346 @@
       !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
       !!---------------------------------------------------------------------
-
+      write(narea+200,*)"dom_grid_crs";call flush(narea+200)
       !
       !                        Switch to coarse grid domain
@@ -366 +378 @@
       njmppt(:) = njmppt_crs(:)
 
+      nfsloop = nfsloop_crs
+      nfeloop = nfeloop_crs
+
+      nfiimpp(:,:) = nfiimpp_crs(:,:)
 
       !

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

@@ -1955 +1955 @@
       INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices
       INTEGER  :: ierr                                ! allocation error status
-      INTEGER :: ii,ij,iproc,iprocno,iprocso
+      INTEGER :: ii,ij,iproc,iprocno,iprocso,iimppt_crs
  
   
@@ -2136 +2136 @@
            WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200)
 
-
+           nfiimpp_crs(ii,ij) = nimppt_crs(jn)
+           WRITE(narea+200,*)"tutu nimppt_crs(jn) ",ii,ij,nimppt_crs(jn) ; call flush(narea+200)
+          
+        ENDDO
+
+        DO ji = 1 , jpni
+           DO jj = 1 ,jpnj
+              jn=nfipproc(ji,jj)+1
+              iimppt_crs = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1
+              nfiimpp_crs(ji,jj) = iimppt_crs
+              IF( jn .GE. 1 )nimppt_crs(jn) = iimppt_crs
+              PRINT*," nfiimpp_crs(ji,jj) ",ji,jj,jn,nfiimpp(ji,jj),nfiimpp_crs(ji,jj)
+           ENDDO
         ENDDO
 
@@ -2148 +2160 @@
         nldi_crs  = nldit_crs(nproc + 1)
         nimpp_crs = nimppt_crs(nproc + 1)
+
+        !nogather=T
+        nfsloop_crs = 1
+        nfeloop_crs = nlci_crs
+        DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop_crs = nldi_crs
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop_crs = nlei_crs
+              ENDIF
+           ENDIF
+        END DO
 
         !==============================================================================================
@@ -2154 +2180 @@
          write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200)
          write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200)
+         write(narea+200,*)"nfsloop_crs nfeloop_crs ",nfsloop_crs,nfeloop_crs ; call flush(narea+200)
 
          ! No coarsening with zoom
@@ -2212 +2239 @@
       nlejt_full(:)  = nlejt(:)
       njmppt_full(:) = njmppt(:)
-      
+     
+      nfsloop_full = nfsloop
+      nfeloop_full = nfeloop
+
+      nfiimpp_full(:,:) = nfiimpp(:,:) 
+
+
       CALL dom_grid_crs  !swich de grille
      

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

@@ -174 +174 @@
             DO jj = 2, jpj_crsm1
                IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
-                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
-                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
-                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
-                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
-                   !
-                   IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
+                  z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
+                     &     - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
+                  z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
+                     &     - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
+                  !
+                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / ocean_volume_crs_t(ji,jj,jk)
                ENDIF
             ENDDO
@@ -215 +215 @@
       
       !  sbc fields  
+
       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )

branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

@@ -253 +253 @@
             DO ji = 2, jpni
                iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+               !cbr 
+               WRITE(narea+200,*)"iimppt",ji,jj,ilcit(ji-1,jj),nreci,iimppt(ji-1,jj),iimppt(ji,jj)
             END DO
          END DO