Ignore:
Timestamp:
Jul 5, 2000, 4:59:27 PM (24 years ago)
Author:
lmdzadmin
Message:

Version de travail de l'interface avec les surfaces. LF

Location:
LMDZ.3.3/branches/rel-LF/libf/dyn3d
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_limit.F

    r2 r99  
    1313c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
    1414c                         pour lecture netcdf dans LMDZ.3.3
     15c modifie par P. Braconnot pour utiliser la version sous-surfaces
    1516c-------------------------------------------------------------
    1617c
    … …  
    3536      REAL phy_rug(klon,360)
    3637      REAL phy_ice(klon,360)
     38CPB
     39      REAL phy_icet(klon,360)
     40      REAL phy_oce(klon,360)
     41      REAL verif
    3742c
    3843      REAL masque(iip1,jjp1)
    3944      REAL mask(iim,jjp1)
    40 
     45CPB
     46C newlmt indique l'utilisation de la sous-maille fractionnelle
     47C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
     48      LOGICAL newlmt, fracterre
     49      PARAMETER(newlmt=.TRUE.)
     50      PARAMETER(fracterre = .TRUE.)
     51CPB
    4152C Declarations pour le champ de depart
    4253      INTEGER imdep, jmdep,lmdep
    … …  
    5263      REAL champ_msk(ibid_msk*jbid_msk)
    5364      REAL dlon_msk(ibid_msk), dlat_msk(jbid_msk)
    54 
     65      REAL*4 zbidon(ibid_msk*jbid_msk)
    5566C Declarations pour le champ interpole 2D
    5667      REAL champint(iim,jjp1)
    … …  
    7586      INTEGER id_tim
    7687      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
     88CPB
     89      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
    7790
    7891      INTEGER i, j, k, l
    … …  
    100113      cpp    = 1004.70885
    101114      dtvr    = daysec/FLOAT(day_step)
     115
    102116c
    103117ccc      CALL iniconst ( non  indispensable )
    … …  
    168182     .             iim, jjp1, rlonv, rlatu, champint)
    169183      CALL gr_int_dyn(champint, masque, iim, jjp1)
    170       DO i = 1, iim
    171          masque(i,1) = FLOAT(NINT(masque(i,1)))
    172          masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
    173       ENDDO
     184      IF ( fracterre ) THEN
     185          DO i = 1, iim
     186            masque(i,1) = masque(i,1)
     187            masque(i,jjp1) = masque(i,jjp1)
     188          END DO
     189      ELSE
     190          DO i = 1, iim
     191            masque(i,1) = FLOAT(NINT(masque(i,1)))
     192            masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
     193          END DO
     194      ENDIF
    174195      DO i = 1, iim
    175196      DO j = 1, jjp1
    … …  
    432453      ENDDO
    433454c
     455      WRITE(*,*) 'phy_nat'
     456      WRITE(*,'(72f4.1)') phy_nat0(1:klon)
     457c
    434458      DO k = 1, 360
    435          CALL gr_dyn_fi(1, iip1, jjp1, klon,
    436      .                  champan(1,1,k), phy_ice(1,k))
    437          DO i = 1, klon
    438             phy_nat(i,k) = phy_nat0(i)
    439             IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
    440                IF (NINT(phy_nat0(i)).EQ.0) THEN
    441                   phy_nat(i,k) = 3.0
    442                ELSE
    443                   phy_nat(i,k) = 2.0
    444                ENDIF
    445             ENDIF
    446          ENDDO
     459        CALL gr_dyn_fi(1, iip1, jjp1, klon,
     460     .      champan(1,1,k), phy_ice(1,k))
     461        IF ( newlmt) THEN
     462
     463CPB  en attendant de mettre fraction de terre
     464c
     465            WHERE(phy_ice(1:klon, k) .GT. 1.) phy_ice(1 : klon, k) = 1.
     466            WHERE(phy_ice(1:klon, k) .LT. 0.) phy_ice(1 : klon, k) = 0.
     467            WRITE(*,*) 'phy_ice : ', k
     468            WRITE(*,'(72f4.1)') phy_ice(1 : klon, k)
     469c
     470            IF (fracterre ) THEN
     471                WRITE(*,*) 'passe dans cas fracterre'
     472                DO i = 1, klon
     473                  phy_nat(i,k) = phy_nat0(i)
     474                  IF (phy_nat0(i) .GE. 0.5 ) THEN
     475                      IF(phy_ice(i,k) .GE. 1.e-5) THEN
     476                          IF ( phy_ice(i,k) .LE. phy_nat(i,k)) THEN
     477                              phy_oce(i,k) = 1. - phy_nat(i,k)
     478                              phy_icet(i,k) = phy_ice(i,k)
     479                              phy_ice(i,k) = 0.
     480                              phy_nat(i,k)= phy_nat(i,k)- phy_icet(i,k)
     481                          ELSE
     482                              phy_oce(i,k) = 1. - phy_ice(i,k)
     483                              phy_icet(i,k) = phy_nat(i,k)
     484                              phy_nat(i,k) = 0.
     485                              phy_ice(i,k) = phy_ice(i,k)
     486     $                            - phy_icet(i,k)
     487                          ENDIF
     488                      ELSE
     489                          phy_icet(i,k) = 0.
     490                          phy_ice(i,k) = 0.
     491                          phy_oce(i,k) = 1. - phy_nat(i,k)
     492                      ENDIF
     493                  ELSE
     494                      phy_oce(i,k) = 1. - phy_nat(i,k)
     495                      IF(phy_ice(i,k) .GE. 1.e-5) THEN
     496                          IF( phy_ice(i,k) .LE. phy_oce(i,k) ) THEN
     497                              phy_icet(i,k) = 0.
     498                              phy_oce(i,k) = phy_oce(i,k) - phy_ice(i,k)
     499                          ELSE
     500                              phy_icet(i,k)=phy_ice(i,k) - phy_oce(i,k)
     501                              phy_ice(i,k) = phy_oce(i,k)
     502                              phy_oce(i,k) = 0.
     503                              phy_nat(i,k) = phy_nat(i,k)-phy_icet(i,k)
     504                          ENDIF
     505                      ELSE
     506                          phy_icet(i,k) = 0.
     507                          phy_ice(i,k) = 0.
     508                      ENDIF
     509                  ENDIF
     510                  verif = phy_nat(i,k) + phy_icet(i,k)+ phy_ice(i,k)
     511     $                + phy_oce(i,k)
     512                  IF ( verif .LT. 1. - 1.e-5 .OR.
     513     $                verif .GT. 1 + 1.e-5) THEN 
     514                      WRITE(*,*) 'pb sous maille au point : i,k,verif '
     515     $                    , i,k,verif
     516                  ENDIF
     517                END DO
     518            ELSE
     519                DO i = 1, klon
     520                  phy_nat(i,k) = phy_nat0(i)
     521                  IF (NINT(phy_nat0(i)).EQ.1 ) THEN
     522                      IF(phy_ice(i,k) .GE. 1.e-5) THEN
     523                          phy_icet(i,k) = phy_ice(i,k)
     524                          phy_ice(i,k) = 0.
     525                          phy_nat(i,k) = phy_nat(i,k) - phy_icet(i,k)
     526                          phy_oce(i,k) = 0.
     527                      ELSE
     528                          phy_icet(i,k) = 0.
     529                          phy_ice(i,k) = 0.
     530                          phy_oce(i,k) = 0.                     
     531                      ENDIF
     532                  ELSE
     533                      IF(phy_ice(i,k) .GE. 1.e-5) THEN
     534                          phy_icet(i,k) = 0.
     535                          phy_nat(i,k) = 0.
     536                          phy_oce(i,k) = 1. - phy_ice(i,k)
     537                      ELSE
     538                          phy_icet(i,k) = 0.
     539                          phy_ice(i,k) = 0.
     540                          phy_oce(i,k) = 1.                     
     541                      ENDIF
     542                  ENDIF
     543                  verif = phy_nat(i,k) + phy_icet(i,k)+ phy_ice(i,k)
     544     $                + phy_oce(i,k)
     545                  IF ( verif .LT. 1. - 1.e-5 .OR.
     546     $                verif .GT. 1 + 1.e-5) THEN 
     547                      WRITE(*,*) 'pb sous maille au point : i,k,verif '
     548     $                    , i,k,verif
     549                  ENDIF
     550                END DO
     551            ENDIF
     552        ELSE 
     553            DO i = 1, klon
     554              phy_nat(i,k) = phy_nat0(i)
     555              IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
     556                  IF (NINT(phy_nat0(i)).EQ.0) THEN
     557                      phy_nat(i,k) = 3.0
     558                  ELSE
     559                      phy_nat(i,k) = 2.0
     560                  ENDIF
     561              ENDIF
     562            END DO
     563        ENDIF
    447564      ENDDO
    448565c
    … …  
    721838      dims(2) = ntim
    722839c
    723 ccc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
    724840      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
    725841      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
    726842     .                        "Jour dans l annee")
    727 ccc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
    728       ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
    729       ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
     843      IF (newlmt) THEN
     844c
     845          ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
     846          ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
     847     .                        "Fraction ocean")
     848c
     849          ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
     850          ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
     851     .                        "Fraction glace de mer")
     852c
     853          ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
     854          ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
     855     .                        "Fraction terre")
     856c
     857          ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
     858          ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
     859     .                        "Fraction land ice")
     860c
     861      ELSE
     862          ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
     863          ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
    730864     .                        "Nature du sol (0,1,2,3)")
    731 ccc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
     865      ENDIF
     866C
    732867      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
    733868      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
    734869     .                        "Temperature superficielle de la mer")
    735 ccc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
    736870      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
    737871      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
    738872     .                        "Reference flux de chaleur au sol")
    739 ccc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
    740873      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
    741874      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
    742875     .                        "Albedo a la surface")
    743 ccc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
    744876      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
    745877      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
    … …  
    757889#ifdef NC_DOUBLE
    758890      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
    759       ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
     891c
     892      IF (newlmt ) THEN
     893          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
     894     $        ,phy_oce(1,k))
     895          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
     896     $        ,phy_ice(1,k))
     897          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
     898     $        ,phy_nat(1,k))
     899          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
     900     $        ,phy_icet(1,k))
     901      ELSE
     902          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
     903     $        ,phy_nat(1,k))
     904      ENDIF
     905c
    760906      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
    761907      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
    … …  
    764910#else
    765911      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
    766       ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
     912      IF (newlmt ) THEN
     913          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
     914     $        ,phy_oce(1,k))
     915          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
     916     $        ,phy_ice(1,k))
     917          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
     918     $        ,phy_nat(1,k))
     919          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
     920     $        ,phy_icet(1,k))
     921      ELSE
     922          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
     923     $        ,phy_nat(1,k))
     924      ENDIF
    767925      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
    768926      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
    … …  
    777935      STOP
    778936      END
     937

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r79 r99  
    216216      !
    217217      varname = 'q'
     218      q3d(:,:,:,:) = 0.0
    218219      qd(:,:,:) = 0.0
    219220      WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/gcm.F

    r79 r99  
    126126
    127127      LOGICAL offline  ! Controle du stockage ds "fluxmass"
    128       PARAMETER (offline=.true.)
     128      PARAMETER (offline=.false.)
    129129
    130130      character*80 dynhist_file, dynhistave_file
    … …  
    140140c   ----------------
    141141
     142      abort_message = 'last timestep reached'
    142143      modname = 'gcm'
    143144      descript = 'Run GCM LMDZ'
    … …  
    434435           ENDIF
    435436c
     437
     438c rajout debug
     439c        lafin = .true.
     440
    436441        CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time  ,
    437442     $                 ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    … …  
    496501
    497502      END IF
     503
     504c ajout debug
     505c               IF( lafin ) then 
     506c                 abort_message = 'Simulation finished'
     507c                 call abort_gcm(modname,abort_message,0)
     508c               ENDIF
    498509       
    499510c   ********************************************************************

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/grid_noro.F

    r79 r99  
    7777      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
    7878      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
    79       integer mask(imar+1,jmar)
     79c$$$ PB     integer mask(imar+1,jmar)
     80      real mask(imar+1,jmar)
    8081      real num_tot(2200,1100),num_lan(2200,1100)
    8182c
    … …  
    257258         IF (weight(ii,jj) .NE. 0.0) THEN
    258259c  Mask
    259            if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
    260              mask(ii,jj)=1
    261            else
    262              mask(ii,jj)=0
    263            endif
     260c$$$           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
     261c$$$             mask(ii,jj)=1
     262c$$$           else
     263c$$$             mask(ii,jj)=0
     264c$$$           ENDIF
     265             mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
    264266c  Mean Orography:
    265267           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
    … …  
    296298       CALL MVA9(zval,iim+1,jjm+1)
    297299       CALL MVA9(zxtzx,iim+1,jjm+1)
    298        CALL MVA9(zxtzy,iim+1,jjm+1)
    299        CALL MVA9(zytzy,iim+1,jjm+1)
     300       CALL MVA9(zxtzy,iim+1,jjm+1) 
     301c$$$       CALL MVA9(zytzy,iim+1,jjm+1)
    300302
    301303       DO ii = 1, imar
    … …  
    312314           if(xq.le.xw) xq=xw
    313315           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
     316c$$$c slope:
     317c$$$           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
     318c$$$c isotropy:
     319c$$$           zgam(ii,jj)=xp/xq*mask(ii,jj)
     320c$$$c angle theta:
     321c$$$           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
     322c$$$           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
     323c$$$           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
     324c$$$           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
     325c$$$           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
     326c$$$           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
     327C$$* PB modif pour maque de terre fractionnaire
    314328c slope:
    315            zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
     329           zsig(ii,jj)=sqrt(xq)
    316330c isotropy:
    317            zgam(ii,jj)=xp/xq*mask(ii,jj)
     331           zgam(ii,jj)=xp/xq
    318332c angle theta:
    319            zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
    320            zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
    321            zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
    322            zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
    323            zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
    324            zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
    325 
     333           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
     334c$$$           zphi(ii,jj)=zmea(ii,jj)
     335c$$$           zmea(ii,jj)=zmea(ii,jj)
     336c$$$           zpic(ii,jj)=zpic(ii,jj)
     337c$$$           zval(ii,jj)=zval(ii,jj)
     338c$$$           zstd(ii,jj)=zstd(ii,jj)
    326339c          print 101,ii,jj,
    327340c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
    … …  
    421434      PARAMETER (ISMo=300,JSMo=200)
    422435      REAL X(IMAR,JMAR),XF(ISMo,JSMo)
    423       real weight(-1:1,-1:1)
     436      real WEIGHTpb(-1:1,-1:1)
    424437
    425438      if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
    … …  
    428441      SUM=0.
    429442      DO IS=-1,1
    430       DO JS=-1,1
    431       WEIGHT(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
    432       SUM=SUM+WEIGHT(IS,JS)
    433       ENDDO
    434       ENDDO
    435 
     443        DO JS=-1,1
     444          WEIGHTpb(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
     445          SUM=SUM+WEIGHTpb(IS,JS)
     446        ENDDO
     447      ENDDO
     448     
     449      WRITE(*,*) 'MVA9 ', IMAR, JMAR
     450      WRITE(*,*) 'MVA9 ', WEIGHTpb
     451      WRITE(*,*) 'MVA9 SUM ', SUM
    436452      DO IS=-1,1
    437       DO JS=-1,1
    438       WEIGHT(IS,JS)=WEIGHT(IS,JS)/SUM
    439       ENDDO
     453        DO JS=-1,1
     454          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
     455        ENDDO
    440456      ENDDO
    441457
    442458      DO J=2,JMAR-1
    443       DO I=2,IMAR-1
    444       XF(I,J)=0.
    445       DO IS=-1,1
    446       DO JS=-1,1
    447          XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHT(IS,JS)
    448       ENDDO
    449       ENDDO
    450       ENDDO
     459        DO I=2,IMAR-1
     460          XF(I,J)=0.
     461          DO IS=-1,1
     462            DO JS=-1,1
     463              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
     464            ENDDO
     465          ENDDO
     466        ENDDO
    451467      ENDDO
    452468
    453469      DO J=2,JMAR-1
    454          XF(1,J)=0.
    455       IS=IMAR-1
    456       DO JS=-1,1
    457          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHT(-1,JS)
    458       ENDDO
    459       DO IS=0,1
    460       DO JS=-1,1
    461          XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHT(IS,JS)
    462       ENDDO
    463       ENDDO
    464          XF(IMAR,J)=XF(1,J)
     470        XF(1,J)=0.
     471        IS=IMAR-1
     472        DO JS=-1,1
     473          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
     474        ENDDO
     475        DO IS=0,1
     476          DO JS=-1,1
     477            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
     478          ENDDO
     479        ENDDO
     480        XF(IMAR,J)=XF(1,J)
    465481      ENDDO
    466482
    467483      DO I=1,IMAR
    468       XF(I,1)=XF(I,2)
    469       XF(I,JMAR)=XF(I,JMAR-1)
     484        XF(I,1)=XF(I,2)
     485        XF(I,JMAR)=XF(I,JMAR-1)
    470486      ENDDO
    471487
    472488      DO I=1,IMAR
    473       DO J=1,JMAR
    474          X(I,J)=XF(I,J)
    475       ENDDO
     489        DO J=1,JMAR
     490          X(I,J)=XF(I,J)
     491        ENDDO
    476492      ENDDO
    477493

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/startvar.F

    r79 r99  
    314314    !
    315315      CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
    316      . iml-1, jml, lon_in, lat_in,
    317      . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
     316     $    iml-1, jml, lon_in, lat_in,
     317    !     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
     318    ! PB masque avec % terre mai 2000
     319     $    phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
    318320      phis = phis * 9.81
    319321    !
    320       masque(:,:) = FLOAT(tmp_int(:,:))
     322    !PB supression ligne suivant pour masque avec % terre
     323    !     masque(:,:) = FLOAT(tmp_int(:,:))
    321324    !
    322325    !  Compute surface roughness
    … …  
    392395              ENDIF
    393396              CALL gr_dyn_fi(1, iml, jml, nbindex, psol_dyn, champ)
     397    ! PB ajout pour masque terre mer fractionneiare   
     398          CASE ('zmasq')
     399              IF (.NOT. ALLOCATED(masque) ) THEN
     400                  CALL start_init_orog ( iml, jml,lon_in, lat_in)
     401              ENDIF
     402              IF ( SIZE(masque) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
     403                WRITE(*,*)
     404     . 'STARTVAR module has been initialized to the wrong size'
     405                 STOP
     406             ENDIF
     407             CALL gr_dyn_fi(1, iml, jml, nbindex, masque, champ)
    394408            CASE ('zmea')
    395409              IF ( .NOT.ALLOCATED(relief)) THEN

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/temps.h

    r2 r99  
    1 c-----------------------------------------------------------------------
    2 c INCLUDE 'temps.h'
     1!-----------------------------------------------------------------------
     2! INCLUDE 'temps.h'
    33
    44      COMMON/temps/itaufin,dt,
    … …  
    99      REAL     dt
    1010
    11 c-----------------------------------------------------------------------
     11!-----------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.