Changeset 177 for LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_limit.F

Timestamp:

Mar 9, 2001, 4:36:10 PM (24 years ago)

Author:

lmdzadmin

Message:

Lots of stuff, plus particulierement:

• appel a ORCHIDEE en etat de marche (pb de grille subsiste)
• modifs de Pascale sur soil dans le cas ou ok_veget=false -

File:

• LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_limit.F (modified) (8 diffs)

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

@@ -101 +101 @@
       REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
       REAL :: flic_tmp(iip1, jjp1)
-      REAL :: champint(iim, jjp1)
 c Diverses variables locales
       REAL time
@@ -153 +152 @@
       zmasq(:) = 0.
       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
-      WHERE (zmasq(1 : klon) .LE. EPSFRA)
+      WHERE (zmasq(1 : klon) .LT. EPSFRA)
           zmasq(1 : klon) = 0.
+      END WHERE 
+      WHERE (1 - zmasq(1 : klon) .LT. EPSFRA)
+          zmasq(1 : klon) = 1.
       END WHERE 
 !      WRITE(*,*)zmasq
@@ -169 +171 @@
           END DO
       ENDIF 
-      DO i = 1, iim
+c$$$      DO i = 1, iim
+c$$$      DO j = 1, jjp1
+c$$$         mask(i,j) = masque(i,j)
+c$$$      ENDDO
+c$$$      ENDDO
+c$$$      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
+      phy_nat0(1:klon) = zmasq(1:klon)
+      mask = 0.
       DO j = 1, jjp1
-         mask(i,j) = masque(i,j)
-      ENDDO
-      ENDDO
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
+        DO i = 1, iim
+          IF ( masque(i,j) .GE. EPSFRA) mask (i,j) = 1
+        END DO 
+      END DO  
 C
 C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
@@ -275 +284 @@
      $    pctsrf(1:klon, is_lic))
 C adequation avec le maque terre/mer
-      WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA ) 
+      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA ) 
           pctsrf(1 : klon, is_lic) = 0. 
       END WHERE
-      WHERE (zmasq( 1 : klon) .LE. EPSFRA) 
+      WHERE (zmasq( 1 : klon) .LT. EPSFRA) 
           pctsrf(1 : klon, is_lic) = 0.
       END WHERE 
@@ -289 +298 @@
             ELSE 
                 pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
+                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
+                    pctsrf(ji,is_ter) = 0.
+                    pctsrf(ji, is_lic) = zmasq(ji)
+                ENDIF 
             ENDIF 
         ENDIF 
@@ -557 +570 @@
 CPB  en attendant de mettre fraction de terre
 c
-          WHERE(phy_ice(1:klon) .GT. 1.) phy_ice(1 : klon) = 1.
+          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
           WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
 c 
@@ -564 +577 @@
             pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
             pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
+            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon) 
+     $            - pctsrf_t(1:klon,is_lic,k)
+c§§ Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
+            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
+                pctsrf_t(1:klon,is_sic,k) = 0.
+            END WHERE 
+            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
+                pctsrf_t(1:klon,is_sic,k) = 0.
+                pctsrf_t(1:klon,is_oce,k) = 0.
+            END WHERE
             DO i = 1, klon
-              pctsrf_t(i,is_sic,k) = (1. - pctsrf_t(i,is_lic,k) -
-     .                               pctsrf_t(i,is_ter,k)) * phy_ice(i)
-              pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_lic,k) -
-     .                      pctsrf_t(i,is_ter,k) - pctsrf_t(i,is_sic,k)  
+c$$              pctsrf_t(i,is_sic,k) = (1. - pctsrf_t(i,is_lic,k) -
+c$$     .                               pctsrf_t(i,is_ter,k)) * phy_ice(i)
+c$$              pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_lic,k) -
+c$$     .                      pctsrf_t(i,is_ter,k) - pctsrf_t(i,is_sic,k)
+              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN 
+                  IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
+                      pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                      pctsrf_t(i,is_oce,k) = 0.
+                  ELSE 
+                      pctsrf_t(i,is_oce,k) = 1 - zmasq(i) 
+     $                    - pctsrf_t(i,is_sic,k)
+                      IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
+                          pctsrf_t(i,is_oce,k) = 0.
+                          pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                      ENDIF 
+                  ENDIF
+              ENDIF  
               if (pctsrf_t(i,is_oce,k) .lt. 0.) then
-                      WRITE(*,*) 'pb sous maille au point : i,k '
-     $                    , i,k,pctsrf_t(:,is_oce,k)
+                  WRITE(*,*) 'pb sous maille au point : i,k '
+     $                , i,k,pctsrf_t(:,is_oce,k)
+              ENDIF
+              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) + 
+     $            pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.) 
+     $            .GT. EPSFRA) THEN 
+                  WRITE(*,*) 'physiq : pb sous surface au point ', i, 
+     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
               ENDIF 
             END DO
-          ELSE 
+        ELSE 
             DO i = 1, klon
               pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
@@ -750 +792 @@
       ENDDO
 c
+      WHERE(phy_sst .LT. 271.35) phy_sst = 271.35
       ierr = NF_CLOSE(ncid)
 c