Changeset 397 for LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

Timestamp:

Jul 22, 2002, 10:50:58 AM (23 years ago)

Author:

lmdzadmin

Message:

Champs supplementaire dans le coupleur (calving) + dependance des routines
"couplees" aux include
LF

File:

• LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90 (modified) (11 diffs)

LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

@@ -43 +43 @@
   real, allocatable, dimension(:),save    :: coastalflow, riverflow
 !!$PB
-  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tmp_rriv, tmp_rcoa
+!!  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tmp_rriv, tmp_rcoa
 !! pour simuler la fonte des glaciers antarctiques
   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: coeff_iceberg
@@ -276 +276 @@
       endif
 !!$PB
-      ALLOCATE (tmp_rriv(iim,jjm+1), stat=error)
-      if (error /= 0) then
-        abort_message='Pb allocation tmp_rriv'
-        call abort_gcm(modname,abort_message,1)
-      endif
-      ALLOCATE (tmp_rcoa(iim,jjm+1), stat=error)
-      if (error /= 0) then
-        abort_message='Pb allocation tmp_rcoa'
-        call abort_gcm(modname,abort_message,1)
-      endif
+!!      ALLOCATE (tmp_rriv(iim,jjm+1), stat=error)
+! !     if (error /= 0) then
+!!        abort_message='Pb allocation tmp_rriv'
+ !!       call abort_gcm(modname,abort_message,1)
+!!      endif
+!!      ALLOCATE (tmp_rcoa(iim,jjm+1), stat=error)
+!!      if (error /= 0) then
+!!        abort_message='Pb allocation tmp_rcoa'
+!!        call abort_gcm(modname,abort_message,1)
+!!      endif
 !!$
     else if (size(coastalflow) /= knon) then
@@ -793 +793 @@
   real, dimension(klon) :: cdrag
 
-  include 'temps.inc'
+#include "temps.inc"
 
   if (check) write(*,*)'Entree ', modname
@@ -1022 +1022 @@
     bidule=0.
     bidule(1:knon)=riverflow(1:knon)
-    call gath2cpl(bidule, tmp_rriv, klon, knon,iim,jjm,ktindex)
+!    call gath2cpl(bidule, tmp_rriv, klon, knon,iim,jjm,ktindex)
     bidule=0.
     bidule(1:knon)=coastalflow(1:knon)
-    call gath2cpl(bidule, tmp_rcoa, klon, knon,iim,jjm,ktindex)
+!    call gath2cpl(bidule, tmp_rcoa, klon, knon,iim,jjm,ktindex)
     alb_new(1:knon) = albedo_out(1:knon,1) 
     alblw(1:knon) = albedo_out(1:knon,2)
@@ -1144 +1144 @@
   real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol
   real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux
-!!$  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
-  REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE :: tmp_tauy
+  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
+!!  REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE :: tmp_tauy
 ! variables a passer au coupleur
   real, dimension(iim, jjm+1) :: wri_sol_ice, wri_sol_sea, wri_nsol_ice 
@@ -1181 +1181 @@
   REAL :: zx_lon(iim,jjm+1), zx_lat(iim,jjm+1), zjulian
   integer :: idayref, itau_w
-  include 'param_cou.h'
-  include 'inc_cpl.h'
-  include 'temps.inc'
+#include "param_cou.h"
+#include "inc_cpl.h"
+#include "temps.inc"
 !
 ! Initialisation
@@ -1336 +1336 @@
       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
        &                          + tauy(ig)        / FLOAT(nexca)
-!!$      cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
-!!$       &                          + riverflow(ig)   / FLOAT(nexca)/dtime
-!!$      cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
-!!$       &                          + coastalflow(ig) / FLOAT(nexca)/dtime
+      cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
+       &                          + riverflow(ig)   / FLOAT(nexca)/dtime
+      cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
+       &                          + coastalflow(ig) / FLOAT(nexca)/dtime
     enddo
-    IF (cpl_index .EQ. 1) THEN 
-        cpl_rriv(:,:) = cpl_rriv(:,:) + tmp_rriv(:,:) / FLOAT(nexca)
-        cpl_rcoa(:,:) = cpl_rcoa(:,:) + tmp_rcoa(:,:) / FLOAT(nexca)
-    ENDIF
+!    IF (cpl_index .EQ. 1) THEN 
+!        cpl_rriv(:,:) = cpl_rriv(:,:) + tmp_rriv(:,:) / FLOAT(nexca)
+!       cpl_rcoa(:,:) = cpl_rcoa(:,:) + tmp_rcoa(:,:) / FLOAT(nexca)
+!    ENDIF
   endif
 
@@ -1442 +1442 @@
       allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error
       allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error
-!!$      allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
-!!$      allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+      allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+      allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
       if (sum_error /= 0) then
         abort_message='Pb allocation variables couplees pour l''ecriture'
@@ -1465 +1465 @@
     call gath2cpl(cpl_taux(1,cpl_index), tmp_taux(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
     call gath2cpl(cpl_tauy(1,cpl_index), tmp_tauy(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
-!!$    call gath2cpl(cpl_rriv(1,cpl_index), tmp_rriv(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
-!!$    call gath2cpl(cpl_rcoa(1,cpl_index), tmp_rcoa(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
+    call gath2cpl(cpl_rriv(1,cpl_index), tmp_rriv(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
+    call gath2cpl(cpl_rcoa(1,cpl_index), tmp_rcoa(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
 
 !
@@ -1495 +1495 @@
       &            tmp_snow(:,:,2) * tamp_srf(:,:,2) / deno
 !!$PB
-!!$        wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno +    &
-!!$      &            tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno
-!!$        wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno +    &
-!!$      &            tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno
         wri_taux = tmp_taux(:,:,1) * tamp_srf(:,:,1) / deno +    &
       &            tmp_taux(:,:,2) * tamp_srf(:,:,2) / deno
@@ -1583 +1583 @@
       deallocate(tmp_tauy, stat=error); sum_error = sum_error + error
 !!$PB
-!!$      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
-!!$      deallocate(tmp_rcoa, stat=error); sum_error = sum_error + error
+      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
+      deallocate(tmp_rcoa, stat=error); sum_error = sum_error + error
       if (sum_error /= 0) then
         abort_message='Pb deallocation variables couplees'