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 7320 – NEMO

Changeset 7320


Ignore:
Timestamp:
2016-11-23T14:24:07+01:00 (7 years ago)
Author:
cbricaud
Message:

create lib_fortran routine for CRS grid and interface it in TOP

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r7312 r7320  
    11661166         ENDDO 
    11671167 
    1168          WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
    1169          WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 
    1170          WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij 
    1171          WRITE(narea+8000-1,*)"nperio jperio ",nperio,jperio 
    1172          WRITE(narea+8000-1,*)"nowe noea",nowe,noea 
    1173          WRITE(narea+8000-1,*)"noso nono",noso,nono 
    1174          WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 
    1175          WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 
    1176          WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 
    1177          WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 
    1178          WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 
    1179          WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci 
    1180          WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1 
    1181          WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj 
    1182          WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1 
    1183          WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 
    1184          WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 
    1185          WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 
     1168         !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
     1169         !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 
     1170         !WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij 
     1171         !WRITE(narea+8000-1,*)"nperio jperio ",nperio,jperio 
     1172         !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 
     1173         !WRITE(narea+8000-1,*)"noso nono",noso,nono 
     1174         !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 
     1175         !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 
     1176         !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 
     1177         !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 
     1178         !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 
     1179         !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci 
     1180         !WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1 
     1181         !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj 
     1182         !WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1 
     1183         !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 
     1184         !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 
     1185         !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 
    11861186 
    11871187         !========================================================================== 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r6772 r7320  
    5757      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file 
    5858      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file 
    59       INTEGER           ::   iif, iil, ijf, ijl 
    6059      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    6160      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations) 
     
    127126      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask_crs, ktype = jp_i1 ) 
    128127      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask_crs, ktype = jp_i1 ) 
    129        
    130        
    131       tmask_i_crs(:,:) = tmask_crs(:,:,1) 
    132       iif = jpreci 
    133       iil = nlci_crs - jpreci + 1 
    134       ijf = jpreci 
    135       ijl = nlcj_crs - jprecj + 1 
    136       
    137       tmask_i_crs( 1:iif ,    :  ) = 0._wp 
    138       tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp 
    139       tmask_i_crs(   :   , 1:ijf ) = 0._wp 
    140       tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp 
    141        
    142        
    143       tpol_crs(1:jpiglo_crs,:) = 1._wp 
    144       fpol_crs(1:jpiglo_crs,:) = 1._wp 
    145       IF( jperio == 3 .OR. jperio == 4 ) THEN 
    146          tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 
    147          fpol_crs(       1      :jpiglo_crs,:) = 0._wp 
    148          IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 
    149             DO ji = iif+1, iil-1 
    150                tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 
    151                & * tpol_crs(mig_crs(ji),1) 
    152             ENDDO 
    153          ENDIF 
    154       ENDIF 
    155       IF( jperio == 5 .OR. jperio == 6 ) THEN 
    156          tpol_crs(      1       :jpiglo_crs,:)=0._wp 
    157          fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 
    158       ENDIF 
    159        
    160128      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    161129                                   !    ! unique point mask 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r7256 r7320  
    6767      !!------------------------------------------------------------------- 
    6868      !! Local variables 
    69       INTEGER  :: ji,jj,jk      ! dummy indices 
    70       INTEGER  :: ierr                                ! allocation error status 
    71       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     69      INTEGER  :: ji,jj,jk           ! dummy indices 
     70      INTEGER  :: ierr               ! allocation error status 
     71      INTEGER  :: ios                ! Local integer output status for namelist read 
     72      INTEGER  :: iif, iil, ijf, ijl ! indices for tmask_i_crs construction 
    7273      REAL(wp) :: zmin,zmax 
    7374      REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w 
     
    309310 
    310311     !--------------------------------------------------------- 
    311      ! 5.  Coarse grid ocean volume and averaging weights 
    312      !--------------------------------------------------------- 
    313      !CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    314      !CALL ldf_tra_crs_init 
    315      !CALL dom_grid_glo   ! Return to parent grid domain 
    316  
     312     ! 5.  Build tmask_i_crs ( for crsdomwri and lib_fortran_crs (glob_sum) 
     313     !--------------------------------------------------------- 
     314     tmask_i_crs(:,:) = tmask_crs(:,:,1) 
     315     iif = jpreci 
     316     iil = nlci_crs - jpreci + 1 
     317     ijf = jpreci 
     318     ijl = nlcj_crs - jprecj + 1 
     319 
     320     tmask_i_crs( 1:iif ,    :  ) = 0._wp 
     321     tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp 
     322     tmask_i_crs(   :   , 1:ijf ) = 0._wp 
     323     tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp 
     324 
     325     tpol_crs(1:jpiglo_crs,:) = 1._wp 
     326     fpol_crs(1:jpiglo_crs,:) = 1._wp 
     327     IF( jperio == 3 .OR. jperio == 4 ) THEN 
     328        tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 
     329        fpol_crs(       1      :jpiglo_crs,:) = 0._wp 
     330        IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 
     331           DO ji = iif+1, iil-1 
     332              tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 
     333              & * tpol_crs(mig_crs(ji),1) 
     334           ENDDO 
     335        ENDIF 
     336     ENDIF 
     337     IF( jperio == 5 .OR. jperio == 6 ) THEN 
     338        tpol_crs(      1       :jpiglo_crs,:)=0._wp 
     339        fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 
     340     ENDIF 
    317341 
    318342     ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r7256 r7320  
    3636 
    3737   !* Fortran utilities                          
    38    USE lib_fortran 
     38   USE lib_fortran_crs , ONLY : glob_sum => glob_sum_crs 
    3939 
    4040   !* Lateral boundary conditions                          
     
    382382 
    383383   !* Fortran utilities                          
    384    USE lib_fortran 
     384   USE lib_fortran , ONLY : glob_sum => glob_sum 
    385385 
    386386   !* Lateral boundary conditions                          
Note: See TracChangeset for help on using the changeset viewer.