Changeset 470 for branches


Ignore:
Timestamp:
01/31/24 09:13:31 (4 months ago)
Author:
aquiquet
Message:

Cleaning branch: some cleaning in flottab - ilemx,ilemy removed

Location:
branches/GRISLIv3/SOURCES
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • branches/GRISLIv3/SOURCES/3D-physique-gen_mod.f90

    r469 r470  
    234234  logical,dimension(nx,ny) :: FLGZMX    !< points stream ou shelf ou ile (equ. ellpt) ">" 
    235235  logical,dimension(nx,ny) :: FLGZMY    !< points stream ou shelf ou ile (equ ellipt) "^" 
    236   logical,dimension(nx,ny) :: ILEMX     !< points ile ">" 
    237   logical,dimension(nx,ny) :: ILEMY     !< points ile "^" 
    238236  logical,dimension(nx,ny) :: fleuvemx  !< actual grounded stream 
    239237  logical,dimension(nx,ny) :: fleuvemy  !< actual grounded stream 

  • branches/GRISLIv3/SOURCES/Draggings_modules/dragging_param_beta_mod.f90

    r405 r470  
    4242  real,dimension(nx,ny) :: hwatmy ! hauteur d'eau staggered grille - afq 
    4343 
    44   real :: coef_ile      ! coef frottement zones iles   (0.1) 
    45  
    4644  real :: neffmin = 1.e5 ! as in neffect, but this should be the exact same variable 
    4745 
    … …  
    6664    implicit none 
    6765 
    68     namelist/drag_param_beta/beta_slope,beta_expo,betamax,betamin,coef_ile 
     66    namelist/drag_param_beta/beta_slope,beta_expo,betamax,betamin 
    6967 
    7068    if (itracebug.eq.1)  call tracebug(' dragging avec neff et slope') 
    … …  
    10199    betamax_2d(:,:) = betamax 
    102100 
    103     !afq -- toblim = 0. !0.7e5 ! afq -- pour les iles, mais est-ce vraiment utile? 
    104  
    105101    niter_nolin = 1 
    106102 
    … …  
    115111  subroutine dragging   ! defini le frottement basal 
    116112 
    117     use module3d_phy, only:neffmx,neffmy,hwater,betamx,betamy,ilemx,ilemy,betamax,flot,& 
     113    use module3d_phy, only:neffmx,neffmy,hwater,betamx,betamy,betamax,flot,& 
    118114         beta_centre 
    119115     
    120116    !$ USE OMP_LIB 
    121117 
    122     !         les iles n'ont pas de condition neff mais ont la condition toblim 
    123     !         (ce bloc etait avant dans flottab) 
    124  
    125  
    126  
    127     !    -- !$OMP DO 
    128     !    -- do j=2,ny 
    129     !    --    do i=2,nx 
    130     !    --       ilemx(i,j)=ilemx(i,j).and.(abs(rog*Hmx(i,j)*sdx(i,j)).lt.toblim) 
    131     !    --       ilemy(i,j)=ilemy(i,j).and.(abs(rog*Hmy(i,j)*sdy(i,j)).lt.toblim) 
    132     !    --    end do 
    133     !    -- end do 
    134     !    -- !$OMP END DO 
    135118 
    136119    implicit none 
    … …  
    173156    betamx(:,:)= beta_slope*(neffmx(:,:)**beta_expo) 
    174157    betamy(:,:)= beta_slope*(neffmy(:,:)**beta_expo) 
    175  
    176     where (ilemx(:,:)) betamx(:,:) = betamx(:,:) * coef_ile 
    177     where (ilemy(:,:)) betamy(:,:) = betamy(:,:) * coef_ile 
    178158 
    179159    betamx(:,:)=max(betamx(:,:),betamin) 

  • branches/GRISLIv3/SOURCES/Draggings_modules/dragging_param_beta_sedim_mod.f90

    r408 r470  
    4242  real,dimension(nx,ny) :: hwatmy ! hauteur d'eau staggered grille - afq 
    4343 
    44   real :: coef_ile      ! coef frottement zones iles   (0.1) 
    45  
    4644  real,dimension(nx,ny) :: h_sedimmx   ! sediment thickness (or rebounded bedrock) 
    4745  real,dimension(nx,ny) :: h_sedimmy   ! sediment thickness (or rebounded bedrock) 
    … …  
    7775    character(len=150) :: file_ncdf    ! fichier netcdf issue des fichiers .dat 
    7876 
    79     namelist/drag_param_beta_sedim/beta_slope,beta_expo,betamax,betamin,coef_ile,file_sedim,seuil_sedim,coef_sedim 
     77    namelist/drag_param_beta_sedim/beta_slope,beta_expo,betamax,betamin,file_sedim,seuil_sedim,coef_sedim 
    8078 
    8179    if (itracebug.eq.1)  call tracebug(' dragging param avec sedim') 
    … …  
    144142  subroutine dragging   ! defini le frottement basal 
    145143 
    146     use module3d_phy, only:neffmx,neffmy,hwater,betamx,betamy,ilemx,ilemy,betamax,flot,& 
     144    use module3d_phy, only:neffmx,neffmy,hwater,betamx,betamy,betamax,flot,& 
    147145         beta_centre 
    148146     
    149147    !$ USE OMP_LIB 
    150148 
    151     !         les iles n'ont pas de condition neff mais ont la condition toblim 
    152     !         (ce bloc etait avant dans flottab) 
    153  
    154  
    155  
    156     !    -- !$OMP DO 
    157     !    -- do j=2,ny 
    158     !    --    do i=2,nx 
    159     !    --       ilemx(i,j)=ilemx(i,j).and.(abs(rog*Hmx(i,j)*sdx(i,j)).lt.toblim) 
    160     !    --       ilemy(i,j)=ilemy(i,j).and.(abs(rog*Hmy(i,j)*sdy(i,j)).lt.toblim) 
    161     !    --    end do 
    162     !    -- end do 
    163     !    -- !$OMP END DO 
    164149 
    165150    implicit none 
    … …  
    210195       betamy(:,:)= beta_slope*(neffmy(:,:)**beta_expo) * coef_sedim 
    211196    endwhere 
    212  
    213     where (ilemx(:,:)) betamx(:,:) = betamx(:,:) * coef_ile 
    214     where (ilemy(:,:)) betamy(:,:) = betamy(:,:) * coef_ile 
    215197 
    216198    betamx(:,:)=max(betamx(:,:),betamin) 

  • branches/GRISLIv3/SOURCES/MISMIP3D_files/dragging_mismip3d_mod.f90

    r4 r470  
    8787 
    8888 
    89 ! initialisation de certains tableaux 
    90     ilemx(:,:)  =  .false. 
    91     ilemy(:,:)  =  .false. 
    92  
    93  
    9489! initialisation des vitesses de glissement : lues dans lect_mismip_mod 
    9590 
    … …  
    118113 
    119114    call drag_non_lin_stag (nx,ny,Uxflgz,Uyflgz,betamx,betamy) 
    120  
    121  
    122 ! pas d'iles 
    123     ilemx(:,:)  =  .false. 
    124     ilemy(:,:)  =  .false. 
    125115 
    126116 

  • branches/GRISLIv3/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90

    r467 r470  
    669669                            taushelf,epsxx,epsyy,epsxy,eps,abar,pvi,pvm,betamx,betamy,beta_centre, & 
    670670                            ablbord_dtt,ice,front,gr_line_schoof,hwater,hdotwater,bsoc,bm,    & 
    671                             flot_marais,neffmx,neffmy,gzmx,gzmy,ilemx,ilemy,   & 
     671                            flot_marais,neffmx,neffmy,gzmx,gzmy,   & 
    672672                            fleuvemx,fleuvemy,flotmx,flotmy,hmx,hmy,sux,suy, & 
    673673                            tpmp,ux,uy,uzr,debug_3d,xlong,ylat,time,dtt 
    … …  
    970970                end if 
    971971                
    972                 if (itab.eq.70) then  ! posx : grounded -> 0, , grzone ->1  ilemx->2   flot->3 
     972                if (itab.eq.70) then  ! posx : grounded -> 0, , grzone ->1    flot->3 
    973973                   do j=1,ny 
    974974                      do i=1,nx   
    975975                         if (gzmx(i,j)) then      
    976                             if (ilemx(i,j)) then     ! ile 
    977                                tab(i,j)=2 
    978                             else if (fleuvemx(i,j)) then 
     976                            if (fleuvemx(i,j)) then 
    979977                               tab(i,j)=5        ! actual grounded streams 
    980978                            else                   
    … …  
    989987                         else                     ! pose 
    990988                            tab(i,j)=0 
    991                          endif 
     989                         enf 
    992990                      end do 
    993991                   end do 
    994992                end if 
    995                 if (itab.eq.71) then   ! posy : grounded -> 0, , grzone ->1  ilemx->2  flot->3 
     993                if (itab.eq.71) then   ! posy : grounded -> 0, , grzone ->1  flot->3 
    996994                   do j=1,ny 
    997995                      do i=1,nx   
    998996                         if (gzmy(i,j)) then  
    999                             if (ilemy(i,j)) then 
    1000                                tab(i,j)=2 
    1001                             else if (fleuvemy(i,j)) then 
     997                            if (fleuvemy(i,j)) then 
    1002998                               tab(i,j)=5        ! actual grounded streams 
    1003999                            else 

  • branches/GRISLIv3/SOURCES/New-remplimat/diagno-L2_mod.f90

    r467 r470  
    136136!  pvi(:,:)=0. 
    137137  Taushelf(:,:)=0. 
    138  
    139   ! attention le bloc suivant est pour debug 
    140 !!$gzmx(:,:)=.false. 
    141 !!$gzmy(:,:)=.false. 
    142 !!$ilemx(:,:)=.false. 
    143 !!$ilemy(:,:)=.false. 
    144 !!$flgzmx(:,:)=flotmx(:,:) 
    145 !!$flgzmy(:,:)=flotmy(:,:) 
    146138 
    147139  call dragging                    ! doit etre appele avant imx_imy 
    … …  
    366358  !$OMP END WORKSHARE 
    367359  !$OMP END PARALLEL 
    368   !i=92 
    369   !j=152 
    370   !write(6,*) 'time',time, uxbar(92,152),gzmx(92,152),ilemx(92,152),flotmx(92,152), flgzmx(92,152) 
    371360 
    372361  end do ! afq -- sur itour_nolin 
    … …  
    380369 
    381370use module3d_phy, only: pvi,abar,flot,gzmx,gzmy, &  
    382                         ilemx,ilemy,eps,taushelf,h,debug_3d,pvm 
     371                        ,eps,taushelf,h,debug_3d,pvm 
    383372use runparam, only: itracebug 
    384373use geography, only: nx,ny,nz 
    … …  
    441430         sf1=sf01 
    442431         sf3=max(sf03,0.01)   ! pour les fleuves de glace, un peu de Glen  
    443       
    444       else if (ilemx(i,j).or.ilemx(iplus1,j).or.ilemy(i,j).or.ilemy(i,jplus1)) then 
    445          sf1=sf01 
    446          sf3=max(sf03,0.01)   ! pour les iles aussi 
    447  
    448432      else 
    449 !         sf1=1 
    450 !         sf3=1 
    451433         sf1=sf01             ! pour la viscosite anisotrope (ici en longitudinal) 
    452434         sf3=sf03 

  • branches/GRISLIv3/SOURCES/flottab2-0.7.f90

    r468 r470  
    2121  implicit none 
    2222 
    23   real ::  surnet !< surnet hauteur de glace au dessus de la mer 
    24   real ::  archim !< test de flottaison 
    25   ! real, parameter :: Hmin=1.001   !< Hmin pour être considere comme point ice  
    26  
    27   integer:: itestf 
    28  
    29   logical,dimension(nx,ny) ::  gz1mx,gz1my 
    30   logical,dimension(nx,ny) ::  fl1mx,fl1my 
    31  
    32  
    33   real,dimension(nx,ny) ::  uxs1   !< uxbar a l'entree de flottab 
    34   real,dimension(nx,ny) ::  uys1   !< uybar a l'entree de flottab 
    35  
    36  
    37   integer pmx,pmy !pm=plus-moins -1 ou 1 pour x et y  
    38  
    39  
    40   ! Variables pour la determination des differents shelfs/stream 
    41   ! (representés comme des taches ou l'on resoud l'eq elliptique) 
    42   !________________________________________________________________ 
    43   integer,parameter               :: n_ta_max=2000!< nombre de tache max 
    44   integer,dimension(nx,ny)        :: table_out    !< pour les numeros des taches 
    45   integer,dimension(nx,ny)        :: tablebis     !< pour les numeros des taches 
    46   integer,dimension(0:n_ta_max)     :: compt        !< contient les equivalence entre les taches 
    47   integer,dimension(0:n_ta_max)     :: nb_pts_tache !< indique le nombre de points par tache 
    48   logical,dimension(0:n_ta_max)     :: iceberg1D      !< T si iceberg, F si calotte posee 
    49  
    50   logical,dimension(nx,ny)        :: mask_tache_ij !< masque de travail  
    51   !< vrai pour toute la tache de i,j 
    52   integer,dimension(2)            :: smax_coord    !< pour le maxloc des iles 
     23 
     24 
     25 
    5326 
    5427  !  Variables pour determiner le point le plus haut (surf) 
    … …  
    5629  !_________________________________________________________ 
    5730 
    58   ! icetrim : T si ice stream, F si calotte posee(vertical shear) 
    59   logical,dimension(n_ta_max) :: icetrim  
    60  
    61   integer ::  ii,jj 
    62   integer ::  smax_i 
    63   integer ::  smax_j 
    64   real    ::  smax_ 
    65   integer ::  numtache 
    66   integer ::  nb_pt 
    67   real    ::  petit_H=0.001 ! pour test ice sur zone flottante 
     31 
    6832contains 
    6933  ! ----------------------------------------------------------------------------------- 
    … …  
    7438  !! @note    - Pose 
    7539  !  @note    - Grounding zone et streams    gzmx et gzmy 
    76   !  @note    - Iles             ilemx, ilemy 
    7740  !  @note    - flottant  flot sur le noeud majeur, flotmx sur le noeud mineur 
    7841  !> 
    … …  
    9659    !      Pose 
    9760    !      Grounding zone et streams    gzmx et gzmy 
    98     !      Iles             ilemx, ilemy 
    9961    !      flottant  flot sur le noeud majeur, flotmx sur le noeud mineur 
    10062 
    … …  
    10668    use module3D_phy, only:igrdline,mk_init,flot,H,sealevel_2d,Bsoc,S,H,B,& 
    10769         ice,front,& 
    108          iceberg,uxbar,uybar,mk,gzmx,gzmy,flotmx,flotmy,hmx,hmy,isynchro,ilemx,ilemy,& 
     70         iceberg,uxbar,uybar,mk,gzmx,gzmy,flotmx,flotmy,hmx,hmy,isynchro,& 
    10971         flgzmx,flgzmy,fbm,bm,bmelt,debug_3D,dt 
    11072    use param_phy_mod, only:row,ro 
    … …  
    11375    implicit none 
    11476     
    115     logical,dimension(nx,ny) :: new_flot_point  !< pour signaler les points qui se mettent a flotter entre 2 pas de temps dtt 
    116     logical,dimension(nx,ny) :: new_flotmx !< pour signaler les points qui deviennent flottantmx entre 2 dtt 
    117     logical,dimension(nx,ny) :: new_flotmy !< pour signaler les points qui deviennent flottantmy entre 2 dtt  
    118  
    119     integer :: i,j 
     77    real ::  archim !< test de flottaison 
     78    real ::  surnet !< surnet hauteur de glace au dessus de la mer 
     79     
     80    logical,dimension(nx,ny) ::  gz1mx,gz1my 
     81    logical,dimension(nx,ny) ::  fl1mx,fl1my 
     82    real,dimension(nx,ny) ::  uxs1   !< uxbar a l'entree de flottab 
     83    real,dimension(nx,ny) ::  uys1   !< uybar a l'entree de flottab 
     84     
     85    integer ::  nb_pt 
     86    real    ::  petit_H=0.001 ! pour test ice sur zone flottante 
     87     
     88    integer :: i,j,ii,jj 
    12089     
    12190    if (itracebug.eq.1)  call tracebug(' Entree dans routine flottab') 
    … …  
    137106    end if 
    138107 
    139  
    140     ! 1-INITIALISATION 
    141     ! ---------------- 
    142     ! initialisation des variables pour detecter les points qui se mettent 
    143     ! a flotter entre 2 dtt 
    144  
    145     !$OMP DO 
    146     do j=1,ny 
    147        do i=1,nx 
    148           new_flot_point(i,j)=.false. 
    149           new_flotmx(i,j)=.false. 
    150           new_flotmy(i,j)=.false. 
    151        enddo 
    152     enddo 
    153     !$OMP END DO 
    154  
    155     ! ICE(:,:)=(H(:,:).gt.1) ! ice=.true. si epaisseur > 1m 
    156  
    157108    !$OMP WORKSHARE 
    158109    ICE(:,:)=0 
    … …  
    175126 
    176127          archim = Bsoc(i,j)+H(i,j)*ro/row -sealevel_2d(i,j) 
    177           !      if ((i.eq.132).and.(j.eq.183)) print*,'archim=',archim 
    178128 
    179129 
    … …  
    182132 
    183133 
    184              ex_pose: if ((.not.FLOT(I,J)).and.(isynchro.eq.1)) then  !  il ne flottait pas avant 
    185                 FLOT(I,J)=.true. 
     134             if (.not.FLOT(I,J)) then               ! il ne flottait pas 
     135 
     136                ! au pas de temps precedent 
     137                flot(i,j)=.true. 
    186138 
    187139                if (igrdline.eq.1) then   ! en cas de grounding line prescrite 
    188140                   flot(i,j)=.false. 
    189141                   H(i,j)=(10.+sealevel_2d(i,j)-Bsoc(i,j))*row/ro  ! pour avoir archim=10 
    190                    new_flot_point(i,j)=.false. 
    191142                endif 
    192143 
    193              else                                       ! isynchro=0 ou il flottait déja 
    194  
    195                 if (.not.FLOT(I,J)) then               ! il ne flottait pas (isynchro=0) 
    196                    new_flot_point(i,j)=.true.          ! signale un point qui ne flottait pas 
    197                    ! au pas de temps precedent 
    198                    flot(i,j)=.true. 
    199  
    200                    if (igrdline.eq.1) then   ! en cas de grounding line prescrite 
    201                       flot(i,j)=.false. 
    202                       H(i,j)=(10.+sealevel_2d(i,j)-Bsoc(i,j))*row/ro  ! pour avoir archim=10 
    203                       new_flot_point(i,j)=.false. 
    204                    endif 
    205  
    206                 endif 
    207              endif ex_pose 
     144             endif 
    208145 
    209146 
    … …  
    214151                FLOT(I,J)=.false. 
    215152             endif 
    216              !cdc correction topo pour suivre  variations sealevel 
    217              !cdd           S(i,j)=Bsoc(i,j)+H(i,j) 
    218153             S(i,j)=Bsoc(i,j)+H(i,j) 
    219154             B(i,j)=Bsoc(i,j) 
    220155 
    221156          else if  ((H(i,j).LE.0.).and.(archim.LT.0.)) then    !    terre deglace qui devient ocean  
    222              !cdc             ice(i,j)=0 
    223              !cdc         H(i,j)=1. 
    224              !cdc  1m           H(i,j)=min(1.,max(0.,(sealevel - Bsoc(i,j))*row/ro-0.01)) 
    225157             flot(i,j)=.true.  !cdc points ocean sont flot meme sans glace 
    226158             H(i,j)=0. 
    … …  
    242174    !$OMP END DO 
    243175 
    244 !!$ do i=1,nx 
    245 !!$    do j=1,ny 
    246 !!$       if (flot(i,j)) then 
    247 !!$          mk(i,j)=1  
    248 !!$       else 
    249 !!$          mk(i,j)=0 
    250 !!$       endif 
    251 !!$    end do 
    252 !!$ end do 
    253  
    254176 
    255177 
    … …  
    268190 
    269191          flotmx(i,j)=flot(i,j).and.flot(i-1,j) 
    270  
    271           ! test pour detecter les nouveaux flotmx entre 2 dtt : 
    272  
    273           if (flotmx(i,j).and.(new_flot_point(i,j).or. & 
    274                new_flot_point(i-1,j))) then 
    275                new_flotmx(i,j)=.true. 
    276           endif 
    277192 
    278193 
    … …  
    294209    end do domain_x 
    295210    !$OMP END DO 
    296     !if (itracebug.eq.1)  call tracebug('  routine flottab apres domain_x') 
     211 
    297212 
    298213    !     3_y    B- NOUVELLE DEFINITION DE FLOTMY 
    … …  
    307222          flotmy(i,j)=flot(i,j).and.flot(i,j-1) 
    308223 
    309           ! test pour detecter les nouveaux flotmy entre 2 dtt : 
    310  
    311           if (flotmy(i,j).and.(new_flot_point(i,j).or.     & 
    312                new_flot_point(i,j-1))) then 
    313                new_flotmy(i,j)=.true. 
    314           endif 
    315  
    316224          !   premiere determination de gzmy 
    317225          !__________________________________________________________________________ 
    … …  
    331239    end do domain_y 
    332240    !$OMP END DO 
    333  
    334 !!$ 
    335 !!$ 
    336 !!$! 4- Condition sur les bords 
    337 !!$ 
    338 !!$       
    339 !!$       do i=2,nx 
    340 !!$         flotmx(i,1) = (flot(i,1).or.flot(i-1,1)) 
    341 !!$         flotmy(i,1) = .false.  
    342 !!$       end do 
    343 !!$        
    344 !!$       do j=2,ny 
    345 !!$          flotmy(1,j) = (flot(1,j).or.flot(1,j-1)) 
    346 !!$          flotmx(1,j) = .false.  
    347 !!$       end do 
    348 !!$ 
    349 !!$       flotmx(1,1) = .false. 
    350 !!$       flotmy(1,1) = .false. 
    351 !!$ 
    352  
    353  
    354     !      4- determination des iles 
    355     !      ------------------------- 
    356     !$OMP WORKSHARE 
    357     ilemx(:,:)=.false. 
    358     ilemy(:,:)=.false. 
    359     !$OMP END WORKSHARE 
    360  
    361     ! afq -- 17/01/19: on supprime les iles. 
    362     !    !       selon x 
    363     !    !$OMP DO 
    364     !    ilesx:  do j=2,ny-1 
    365     !       do i=3,nx-2 
    366     !          !                       F   G   F    
    367     !          !                           x 
    368     !          ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    369     !          if ((flot(i-1,j).and..not.flot(i,j).and.flot(i+1,j)).and. & 
    370     !               (sdx(i,j).LT.1.E-02)) then 
    371     !             ilemx(i,j)=.true. 
    372     !             ilemx(i+1,j)=.true. 
    373  
    374     !             !                      F  G   G   F 
    375     !             !                         x 
    376     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    377     !          else if ((flot(i-1,j).and..not.flot(i,j)                  & 
    378     !               .and..not.flot(i+1,j)).and.flot(i+2,j).and.           & 
    379     !               (sdx(i,j).LT.1.E-02.and.sdx(i+1,j).LT.1.E-02)) then 
    380     !             ilemx(i,j)=.true. 
    381     !             ilemx(i+1,j)=.true. 
    382     !             ilemx(i+2,j)=.true. 
    383  
    384     !             !                      F   G   G   F 
    385     !             !                              x 
    386     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    387     !          else if ((flot(i-2,j).and..not.flot(i-1,j)                & 
    388     !               .and..not.flot(i,j)).and.flot(i+1,j).and.             & 
    389     !               (sdx(i,j).LT.1.E-02.and.sdx(i-1,j).LT.1.E-02)) then 
    390     !             ilemx(i-1,j)=.true. 
    391     !             ilemx(i,j)=.true. 
    392     !             ilemx(i+1,j)=.true. 
    393  
    394     !             !                      F   G   G   G    F 
    395     !             !                              x 
    396     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    397     !          else if ((i.lt.nx-2)                                      & 
    398     !               .and.(flot(i-2,j).and..not.flot(i-1,j)                & 
    399     !               .and..not.flot(i,j)).and..not.flot(i+1,j)             & 
    400     !               .and.flot(i+2,j).and.                                & 
    401     !               (sdx(i,j).LT.1.E-02.and.sdx(i-1,j).LT.1.E-02         & 
    402     !               .and.sdx(i+1,j).LT.1.E-02)) then 
    403     !             ilemx(i-1,j)=.true. 
    404     !             ilemx(i,j)=.true. 
    405     !             ilemx(i+1,j)=.true. 
    406     !             ilemx(i+2,j)=.true. 
    407  
    408     !          endif 
    409  
    410     !       end do 
    411     !    end do ilesx 
    412     !    !$OMP END DO 
    413  
    414     !    !       selon y 
    415     !    !$OMP DO 
    416     !    ilesy: do j=3,ny-2 
    417     !       do i=2,nx-1 
    418     !          !                       F   G   F    
    419     !          !                           x 
    420     !          ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    421     !          if ((flot(i,j-1).and..not.flot(i,j).and.flot(i,j+1)).and. & 
    422     !               (sdy(i,j).LT.1.E-02)) then 
    423     !             ilemy(i,j)=.true. 
    424     !             ilemy(i,j+1)=.true. 
    425  
    426     !             !                      F  G   G   F 
    427     !             !                         x 
    428     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    429     !          else if ((flot(i,j-1).and..not.flot(i,j)                  & 
    430     !               .and..not.flot(i,j+1)).and.flot(i,j+2).and.           & 
    431     !               (sdy(i,j).LT.1.E-02.and.sdy(i,j+1).LT.1.E-02)) then 
    432     !             ilemy(i,j)=.true. 
    433     !             ilemy(i,j+1)=.true. 
    434     !             ilemy(i,j+2)=.true. 
    435  
    436     !             !                      F   G   G   F 
    437     !             !                              x 
    438     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    439     !          else if ((flot(i,j-2).and..not.flot(i,j-1)                 & 
    440     !               .and..not.flot(i,j)).and.flot(i,j+1).and.              & 
    441     !               (sdy(i,j).LT.1.E-02.and.sdy(i,j-1).LT.1.E-02)) then 
    442     !             ilemy(i,j-1)=.true. 
    443     !             ilemy(i,j)=.true. 
    444     !             ilemy(i,j+1)=.true. 
    445  
    446     !             !                      F   G   G   G    F 
    447     !             !                              x 
    448     !             ! modif tof 26/08/02 limite sur la pente (si diff S > 400 m) 
    449     !          else if ((j.lt.ny-2)                                      & 
    450     !               .and.(flot(i,j-2).and..not.flot(i,j-1)                & 
    451     !               .and..not.flot(i,j)).and..not.flot(i,j+1)             & 
    452     !               .and.flot(i,j+2).and.                                & 
    453     !               (sdy(i,j).LT.1.E-02.and.sdy(i,j-1).LT.1.E-02         & 
    454     !               .and.sdy(i,j+1).LT.1.E-02)) then  
    455     !             ilemy(i,j-1)=.true. 
    456     !             ilemy(i,j)=.true. 
    457     !             ilemy(i,j+1)=.true. 
    458     !             ilemy(i,j+2)=.true. 
    459     !          endif 
    460     !       end do 
    461     !    end do ilesy 
    462     !    !$OMP END DO 
    463     !    ! fin des iles 
    464  
    465     !$OMP END PARALLEL 
    466241 
    467242 
    … …  
    471246 
    472247    if (itracebug.eq.1)  call tracebug(' routine flottab apres call dragging') 
    473 !!$call detect_assym(nx,ny,0,41,1,0,1,0,H,itestf) 
    474 !!$if (itestf.gt.0) then 
    475 !!$   write(6,*) 'dans flottab apres dragging asymetrie sur H  pour time=',time 
    476 !!$   stop 
    477 !!$else 
    478 !!$   write(6,*) 'dans flottab aapres dragging pas d asymetrie sur H  pour time=',time 
    479 !!$ 
    480 !!$end if 
    481248 
    482249    !   6- calcule les vitesses des points qui sont devenus gzm 
    … …  
    523290 
    524291    !$OMP WORKSHARE 
    525     flgzmx(:,:)=(flotmx(:,:).or.gzmx(:,:).or.ilemx(:,:)) 
     292    flgzmx(:,:)=(flotmx(:,:).or.gzmx(:,:)) 
    526293    where (hmx(:,:).eq.0.) 
    527294       flgzmx(:,:) = .false. 
    528295    endwhere 
    529     flgzmy(:,:)=(flotmy(:,:).or.gzmy(:,:).or.ilemy(:,:)) 
     296    flgzmy(:,:)=(flotmy(:,:).or.gzmy(:,:)) 
    530297    where (hmy(:,:).eq.0.) 
    531298       flgzmy(:,:) = .false. 
    … …  
    541308    do j=2,ny-1 
    542309       do i=2,nx-1 
    543  
    544           ! if (i.gt.2.AND.i.lt.nx) then    
    545310          fbm(i,j)=flot(i,j).and.      &  
    546311               ((.not.flot(i+1,j)).or.(.not.flot(i,j+1)) & 
    547312               .or.(.not.flot(i-1,j)).or.(.not.flot(i,j-1))) 
    548           !     endif 
    549313       end do 
    550314    end do 
    … …  
    558322 
    559323 
    560  
    561 !!$do i=3,nx-2 
    562 !!$   do j=3,ny-2 
    563 !!$      if (h(i,j).gt.1.1) ice(i,j)=1         
    564 !!$   end do 
    565 !!$end do 
    566     !                   print*, 'flolottab debug', H(71,25),flot(71,25),bm(71,25),ice(71,25),time 
    567     !print*,'H(90,179) flottab 2',H(90,179),ice(90,179),flot(90,179) 
    568324    !$OMP WORKSHARE 
    569325    where (flot(:,:)) 
    570        !cdc 1m       where (H(:,:).gt.max(Hmin,Hmin+BM(:,:)-Bmelt(:,:))) 
    571326       where (H(:,:).gt.max(BM(:,:)-Bmelt(:,:)+petit_H,0.)*dt) 
    572           !cdc                   where (H(:,:).gt.0.) 
    573327          ice(:,:)=1 
    574328       elsewhere  
    … …  
    587341    !$OMP END WORKSHARE 
    588342    !$OMP END PARALLEL 
    589     !    print*,'flottab',time,H(191,81),bm(191,81),bmelt(191,81),(BM(191,81)-Bmelt(191,81)+petit_H)*dt,ice(191,81) 
    590     !print*,'H(90,179) flottab 3',H(90,179),ice(90,179),flot(90,179),Bsoc(90,179)+H(90,179)*ro/row -sealevel 
    591  
    592     !call determin_front ! cette version ne conserve pas la masse !!! 
    593     call determin_front_tof ! version simplifiee 
     343 
     344    call determin_front_tof 
    594345 
    595346    ! pour sorties initMIP: 
    … …  
    613364 
    614365    implicit none 
     366     
     367    ! Variables pour la determination des differents shelfs/stream 
     368    ! (representés comme des taches ou l'on resoud l'eq elliptique) 
     369    !________________________________________________________________ 
     370    integer,parameter               :: n_ta_max=2000!< nombre de tache max 
     371    integer,dimension(nx,ny)        :: table_out    !< pour les numeros des taches 
     372    integer,dimension(0:n_ta_max)     :: compt        !< contient les equivalence entre les taches 
     373    integer,dimension(0:n_ta_max)     :: nb_pts_tache !< indique le nombre de points par tache 
     374    logical,dimension(0:n_ta_max)     :: iceberg1D      !< T si iceberg, F si calotte posee 
     375    logical,dimension(n_ta_max) :: icetrim !< icetrim : T si ice stream, F si calotte posee(vertical shear) 
     376     
     377    logical,dimension(nx,ny)        :: mask_tache_ij !< masque de travail  
     378    integer,dimension(2)            :: smax_coord    !< pour le maxloc des iles 
     379    integer ::  smax_i 
     380    integer ::  smax_j 
     381    real    ::  smax_ 
     382     
    615383    integer :: i,j 
    616384    integer :: indice 
    … …  
    619387    !      integer :: mask_nb = 4 
    620388    integer,parameter :: mask_nb = 2   ! version ou on ne compte pas les diagonales 
    621     !     integer,dimension(mask_nb) :: mask 
    622389    integer,dimension(mask_nb) :: mask 
    623390 
    … …  
    630397       compt(i)=i 
    631398    enddo 
    632     !      table_in  = .false. 
    633399    !$OMP PARALLEL 
    634400    !$OMP WORKSHARE 
    … …  
    639405    !$OMP END WORKSHARE 
    640406    !$OMP END PARALLEL 
    641     !    open(unit=100,file="tache.data",status='replace') 
    642407 
    643408    ! 2-reperage des taches 
    … …  
    659424                   if (mask(indice).gt.0) label=min(label,mask(indice)) 
    660425                enddo 
    661                 !cdc       label=min(label,minval(mask(:), mask=mask > 0)) 
    662426 
    663427                !on fixe la valeur de la tache voisine minimun au point etudie (via label) 
    … …  
    774538             !cdc transfere dans calving :              
    775539          else ! on est sur un iceberg                          !   test1 
    776              iceberg(i,j)=iceberg1D(table_out(i,j)) 
    777              !~        ice(i,j)=0 
    778              !~        h(i,j)=0. !1. afq, we should put everything in calving! 
    779              !~        surnet=H(i,j)*(1.-ro/row) 
    780              !~        S(i,j)=surnet+sealevel 
    781              !~        B(i,j)=S(i,j)-H(i,j)              
     540             iceberg(i,j)=iceberg1D(table_out(i,j))  
    782541          endif test1 
    783542       end do 
    … …  
    801560    implicit none 
    802561     
     562    integer :: pmx,pmy !pm=plus-moins -1 ou 1 pour x et y  
    803563    integer :: i,j,k 
    804564    integer :: i_moins1,i_plus1,i_plus2 
    … …  
    863623    !$OMP ENd PARALLEL 
    864624 
    865 !!$call detect_assym(nx,ny,0,41,1,0,1,0,H,itestf) 
    866 !!$if (itestf.gt.0) then 
    867 !!$   write(6,*) 'dans front avant remplissage baies asymetrie sur H  pour time=',time 
    868 !!$   stop 
    869 !!$else 
    870 !!$   write(6,*) 'dans front avant remplissage baies pas d asymetrie sur H  pour time=',time 
    871 !!$ 
    872 !!$end if 
    873  
    874  
    875     !     print*,'dans remplissage baies',time 
    876625 
    877626    baies: do k=1,2 
    … …  
    916665    end do baies 
    917666 
    918 !!$call detect_assym(nx,ny,0,41,1,0,1,0,H,itestf) 
    919 !!$if (itestf.gt.0) then 
    920 !!$   write(6,*) 'dans front apres remplissage baies asymetrie sur H  pour time=',time 
    921 !!$   stop 
    922 !!$else 
    923 !!$   write(6,*) 'dans front apres remplissage baies pas d asymetrie sur H  pour time=',time 
    924 !!$ 
    925 !!$end if 
    926667 
    927668    !$OMP PARALLEL 
    … …  
    970711    front(nx,ny)=ice(nx,ny-1)+ice(nx-1,ny) 
    971712 
    972 !!$call detect_assym(nx,ny,0,41,1,0,1,0,H,itestf) 
    973 !!$if (itestf.gt.0) then 
    974 !!$   write(6,*) 'dans front apres front asymetrie sur H  pour time=',time 
    975 !!$   stop 
    976 !!$else 
    977 !!$   write(6,*) 'dans front apres front pas d asymetrie sur H  pour time=',time 
    978 !!$ 
    979 !!$end if 
    980713 
    981714    !   on ne compte pas les taches de glace de 2 cases (horizontales ou verticales) 
    … …  
    1111844 
    1112845    implicit none 
     846     
     847    integer,parameter               :: n_ta_max=2000!< nombre de tache max 
    1113848 
    1114849    integer :: i,j 

  • branches/GRISLIv3/SOURCES/furst_schoof_mod.f90

    r446 r470  
    144144                   !flux        !     in            out         G out            in 
    145145 
    146  
    147                    !afq --                 if (.not.(ilemx(i,j)).and..not.(ilemx(i-1,j))) then 
    148146 
    149147                   ! extrapolation pour avoir uxbar(i-1,j) qui sera ensuite prescrit dans call rempli_L2 
    … …  
    178176                   !flux        !     in             in           out  G         out           in 
    179177 
    180                    !afq --                 if (.not.(ilemx(i,j)).and..not.(ilemx(i+1,j))) then 
    181  
    182178                   ! extrapolation pour avoir uxbar(i,j) qui sera ensuite prescrit dans call rempli_L2 
    183179 
    … …  
    236232                   !flux        !                    in           out        G  out            in 
    237233 
    238                    !afq --                 if (.not.(ilemx(i,j)).and..not.(ilemx(i+1,j))) then 
    239  
    240234                   ! extrapolation pour avoir uxbar(i,j) qui sera ensuite prescrit dans call rempli_L2 
    241235 
    … …  
    263257                   !            !             i-1            i            i+1           i+2          i+3 
    264258                   !flux        !                     in           out  G        out            in 
    265  
    266                    !afq --                 if (.not.(ilemx(i+1,j)).and..not.(ilemx(i+2,j))) then 
    267259 
    268260                   ! extrapolation pour avoir uxbar(i,j) qui sera ensuite prescrit dans call rempli_L2 
    … …  
    328320                   !flux        !     in            out         G out            in 
    329321 
    330                    !afq --                 if (.not.(ilemy(i,j)).and..not.(ilemy(i,j-1))) then 
    331  
    332322                   ! extrapolation pour avoir uybar(i,j-1) qui sera ensuite prescrit dans call rempli_L2 
    333323 
    … …  
    356346                   !            j-2           j-1            j            j+1           j+2 
    357347                   !flux        !     in             in           out  G         out           in 
    358  
    359                    !afq --                 if (.not.(ilemy(i,j)).and..not.(ilemy(i,j+1))) then 
    360348 
    361349                   ! extrapolation pour avoir uybar(i,j) qui sera ensuite prescrit dans call rempli_L2 
    … …  
    415403                   !flux        !                    in           out        G  out            in 
    416404 
    417                    !afq --                 if (.not.(ilemy(i,j)).and..not.(ilemy(i,j+1))) then 
    418  
    419405                   ! extrapolation pour avoir uybar(i,j) qui sera ensuite prescrit dans call rempli_L2 
    420406 
    … …  
    442428                   !            !             j-1            j            j+1           j+2          j+3 
    443429                   !flux        !                     in           out  G        out            in 
    444  
    445                    !afq --                 if (.not.(ilemy(i,j+1)).and..not.(ilemy(i,j+2))) then 
    446430 
    447431                   ! extrapolation pour avoir uybar(i,j) qui sera ensuite prescrit dans call rempli_L2 

  • branches/GRISLIv3/SOURCES/initial2-0.4.f90

    r467 r470  
    2020                    slope,taub,ubx,uby,uzk,uxbar,uybar,ibase,tpmp,mk,mk0,h,front, & 
    2121                    bsoc,flot,sealevel_2D,flotmx,flotmy,gzmx, & 
    22                     gzmy,flgzmx,flgzmy,ilemx,ilemy,sdx,sdy,ux,uy,uzr,t,s 
     22                    gzmy,flgzmx,flgzmy,sdx,sdy,ux,uy,uzr,t,s 
    2323  use geography, only: nx,ny,nz,nzm,dx 
    2424  USE param_phy_mod,only: ro,row 
    … …  
    8484  FLGZMX(:,:)=.FALSE. 
    8585  FLGZMY(:,:)=.FALSE. 
    86   ILEMX(:,:)=.FALSE. 
    87   ILEMY(:,:)=.FALSE. 
    8886 
    8987 

  • branches/GRISLIv3/SOURCES/printdebug.f90

    r426 r470  
    2121 
    2222  use module3D_phy, only: num_debug,ndebug,time,dt,H,S,sdx,sdy,Bsoc,Hdot,uxbar,uybar,& 
    23        gzmx,gzmy,ilemx,ilemy,flotmx,flotmy,hmx,hmy 
     23       gzmx,gzmy,flotmx,flotmy,hmx,hmy 
    2424  use runparam, only: runname 
    2525  use geography, only: nx,ny 
    … …  
    141141  !______________________________________ 
    142142 
    143   !      grounded -> 0, , grzone ->1  ilemx->2   flot->3 
     143  !      grounded -> 0, , grzone ->1  flot->3 
    144144 
    145145  do j=jj-2,jj+2 
    … …  
    147147 
    148148        if (gzmx(i,j)) then      
    149            if (ilemx(i,j)) then     ! ile 
    150               posx(i,j)=2 
    151            else                   
    152               posx(i,j)=1        ! grounded zone 
    153            endif 
     149           posx(i,j)=1        ! grounded zone 
    154150        else if (flotmx(i,j)) then ! flottant 
    155151           if (HMX(i,j).gt.1.) then 
    … …  
    164160  end do 
    165161 
    166   write(num_debug,*)'Posx grounded -> 0, , grzone ->1  ilemx->2   flot->3' 
     162  write(num_debug,*)'Posx grounded -> 0, , grzone ->1  flot->3' 
    167163  write(num_debug,fmt='(4(i7,8x))') Posx(ii-1:ii+2,jj+2:jj-2:-1) 
    168164  write(num_debug,*)'-----------------------------------------------------------' 
    169165  !     write(num_debug,*) 'apres posx', ii,jj 
    170  
    171 !!$! pour changer de page 
    172 !!$      write(num_debug,*) 
    173 !!$      write(num_debug,*) 
    174 !!$      write(num_debug,*) 
    175 !!$      write(num_debug,*) 
    176 !!$      write(num_debug,*)   
    177 !!$      write(num_debug,*) 
    178166 
    179167  !________________________________________________________ selon y  
    … …  
    199187 
    200188        if (gzmy(i,j)) then  
    201            if (ilemy(i,j)) then 
    202               posy(i,j)=2 
    203            else 
    204               posy(i,j)=1 
    205            endif 
     189           posy(i,j)=1 
    206190        else if (flotmy(i,j)) then 
    207191           if (HMY(i,j).gt.1.) then 
    … …  
    224208  write(num_debug,*)'-----------------------------------------------------------' 
    225209 
    226   !     write(num_debug,*) 'apres posy', ii,jj 
    227210 
    228211  close(num_debug) 
    229   !     write(num_debug,*) 'apres Sdx', ii,jj 
    230212 
    231213  return 
Note: See TracChangeset for help on using the changeset viewer.