Changeset 634 for LMDZ4/branches/LMDZ4_par_0/libf/phylmd/interface_surf.F90

Timestamp:

May 4, 2005, 5:11:29 PM (19 years ago)

Author:

Laurent Fairhead

Message:

Modifications faites à la physique pour la rendre parallele YM
Une branche de travail LMDZ4_par_0 a été créée provisoirement afin de tester
les modifs pleinement avant leurs inclusions dans le tronc principal
LF

File:

• LMDZ4/branches/LMDZ4_par_0/libf/phylmd/interface_surf.F90 (modified) (24 diffs)

LMDZ4/branches/LMDZ4_par_0/libf/phylmd/interface_surf.F90

@@ -22 +22 @@
 ! L. Fairhead, LMD, 02/2000
 
-  USE ioipsl
+!ym  USE ioipsl
 
   IMPLICIT none
@@ -76 +76 @@
       & z0_new, pctsrf_new, agesno,fqcalving,ffonte, run_off_lic_0)
 
-
+   USE dimphy,only : monocpu
 ! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general 
 ! (sols continentaux, oceans, glaces) pour les fluxs de chaleur et d'humidite.
@@ -235 +235 @@
   real, dimension(klon):: fder_prev
   REAL, dimension(klon) :: bidule
+  INTEGER :: j
 
   if (check) write(*,*) 'Entree ', modname
@@ -394 +395 @@
 
     else
+    
+      if (.not.monocpu) then
+        abort_message='Appel a ORCHIDEE non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
 !!      CALL albsno(klon,agesno,alb_neig_grid)  
 !
@@ -434 +440 @@
 !
     if (ocean == 'couple') then
+      if (.not.monocpu) then
+        abort_message='Couplage avec l OCEAN non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
+
       if (nexca == 0) then
         abort_message='nexca = 0 dans interfoce_cpl'
@@ -510 +521 @@
     if (ocean == 'couple') then
 
+      if (.not.monocpu) then
+        abort_message='Couplage avec l OCEAN non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
+
       cumul = .true.
 
@@ -555 +571 @@
 !
     if (ocean == 'couple') then
-
+      
+      if (.not.monocpu) then
+        abort_message='Couplage avec l OCEAN non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
+      
       cumul =.false.
 
@@ -596 +617 @@
 !IM cf LF
       DO ii = 1, knon
-       IF (pctsrf_new(ii,nisurf) < EPSFRA) then
+       j=knindex(ii)
+       IF (pctsrf_new(j,nisurf) < EPSFRA) then
           snow(ii) = 0.0
 !IM cf LF/JLD         tsurf(ii) = RTT - 1.8
@@ -666 +688 @@
     if (ocean == 'couple') then
 
+      if (.not.monocpu) then
+        abort_message='Couplage avec l OCEAN non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
+
       cumul =.true.
 
@@ -733 +760 @@
 
 ! passage du run-off des glaciers calcule dans fonte_neige au coupleur
-    bidule=0.
-    bidule(1:knon)= run_off_lic(1:knon)    
-    call gath2cpl(bidule, tmp_rlic, klon, knon,iim,jjm,knindex)
+    if (ocean=='couple') then
+      
+      if (.not.monocpu) then
+        abort_message='Couplage avec l OCEAN non encore parallelise !!'
+        call abort_gcm(modname,abort_message,1)
+      endif
+
+      bidule=0.
+      bidule(1:knon)= run_off_lic(1:knon)    
+      call gath2cpl(bidule, tmp_rlic, klon, knon,iim,jjm,knindex)
+    
+    endif
 !
 ! calcul albedo
@@ -1239 +1275 @@
       & pctsrf_new)
 
+   USE ioipsl
 ! Cette routine sert d'interface entre le modele atmospherique et un 
 ! coupleur avec un modele d'ocean 'complet' derriere
@@ -1909 +1946 @@
 !
   SUBROUTINE interfoce_lim(itime, dtime, jour, &
-     & klon, nisurf, knon, knindex, &
+     & klon_xx, nisurf, knon, knindex, &
      & debut,  &
-     & lmt_sst, pctsrf_new)
+     & lmt_sst_p, pctsrf_new_p)
+     
+     USE dimphy,klon=>klon2,klon2=>klon
 
 ! Cette routine sert d'interface entre le modele atmospherique et un fichier
@@ -1938 +1977 @@
   real   , intent(IN) :: dtime
   integer, intent(IN) :: jour
+  integer, intent(in) :: klon_xx
   integer, intent(IN) :: nisurf
   integer, intent(IN) :: knon
-  integer, intent(IN) :: klon
-  integer, dimension(klon), intent(in) :: knindex
+  integer, dimension(klon2), intent(in) :: knindex
   logical, intent(IN) :: debut
 
 ! Parametres de sortie
-  real, intent(out), dimension(klon) :: lmt_sst
-  real, intent(out), dimension(klon,nbsrf) :: pctsrf_new
+  real, intent(out), dimension(klon2) :: lmt_sst_p
+  real, intent(out), dimension(klon2,nbsrf) :: pctsrf_new_p
+
+!  real, dimension(klon) :: lmt_sst
+  real, dimension(klon,nbsrf) :: pctsrf_new
 
 ! Variables locales
@@ -1962 +2004 @@
   logical, save     :: check = .FALSE.
 ! Champs lus dans le fichier de CL
-  real, allocatable , save, dimension(:) :: sst_lu, rug_lu, nat_lu
-  real, allocatable , save, dimension(:,:) :: pct_tmp
+  real, allocatable , save, dimension(:) :: sst_lu_p, rug_lu_p, nat_lu_p
+  real, allocatable , save, dimension(:,:) :: pct_tmp_p
+  real, dimension(klon,nbsrf) :: pct_tmp
+  real, dimension(klon) :: sst_lu
+  real, dimension(klon) :: nat_lu
 !
 ! quelques variables pour netcdf
@@ -1973 +2018 @@
 ! Fin déclaration
 !
-    
-  if (debut .and. .not. allocated(sst_lu)) then
+  
+  if (debut .and. .not. allocated(sst_lu_p)) then
     lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
     jour_lu = jour - 1
-    allocate(sst_lu(klon))
-    allocate(nat_lu(klon))
-    allocate(pct_tmp(klon,nbsrf))
+    allocate(sst_lu_p(klon2))
+    allocate(nat_lu_p(klon2))
+    allocate(pct_tmp_p(klon2,nbsrf))
   endif
 
@@ -1992 +2037 @@
 ! Ouverture du fichier
 !
+    if (phy_rank==0) then
+    
     fich = trim(fich)
     ierr = NF_OPEN (fich, NF_NOWRITE,nid)
@@ -2131 +2178 @@
 !
     ierr = NF_CLOSE(nid)
-    deja_lu = .true.
-    jour_lu = jour
-  endif
+   endif ! phyrank
 !
 ! Recopie des variables dans les champs de sortie
 !
-  lmt_sst = 999999999.
+  call ScatterField(sst_lu,sst_lu_p,1)
+  call ScatterField(pct_tmp(:,is_oce),pct_tmp_p(:,is_oce),1)
+  call ScatterField(pct_tmp(:,is_sic),pct_tmp_p(:,is_sic),1)
+  
+   deja_lu = .true.
+   jour_lu = jour
+  endif   
+  
+  lmt_sst_p = 999999999.
+  
   do ii = 1, knon
-    lmt_sst(ii) = sst_lu(knindex(ii))
+    lmt_sst_p(ii) = sst_lu_p(knindex(ii))
   enddo
 
-  pctsrf_new(:,is_oce) = pct_tmp(:,is_oce)
-  pctsrf_new(:,is_sic) = pct_tmp(:,is_sic)
+  do ii=1,klon2
+    pctsrf_new_p(ii,is_oce)=pct_tmp_p(ii,is_oce)
+    pctsrf_new_p(ii,is_sic)=pct_tmp_p(ii,is_sic)
+  enddo
+  
 
   END SUBROUTINE interfoce_lim
@@ -2151 +2208 @@
 !
   SUBROUTINE interfsur_lim(itime, dtime, jour, &
-     & klon, nisurf, knon, knindex, &
+     & klon_xx, nisurf, knon, knindex, &
      & debut,  &
-     & lmt_alb, lmt_rug)
+     & lmt_alb_p, lmt_rug_p)
+
+     USE dimphy,klon=>klon2,klon2=>klon
 
 ! Cette routine sert d'interface entre le modele atmospherique et un fichier
@@ -2184 +2243 @@
   integer, intent(IN) :: nisurf
   integer, intent(IN) :: knon
-  integer, intent(IN) :: klon
-  integer, dimension(klon), intent(in) :: knindex
+  integer, intent(IN) :: klon_xx
+  integer, dimension(klon2), intent(in) :: knindex
   logical, intent(IN) :: debut
 
 ! Parametres de sortie
-  real, intent(out), dimension(klon) :: lmt_alb
-  real, intent(out), dimension(klon) :: lmt_rug
+  real, intent(out), dimension(klon2) :: lmt_alb_p
+  real, intent(out), dimension(klon2) :: lmt_rug_p
+
+!  real,  dimension(klon) :: lmt_alb
+!  real,  dimension(klon) :: lmt_rug
 
 ! Variables locales
@@ -2206 +2268 @@
   logical,save     :: check = .false.
 ! Champs lus dans le fichier de CL
-  real, allocatable , save, dimension(:) :: alb_lu, rug_lu
+  real, allocatable , save, dimension(:) :: alb_lu_p, rug_lu_p
+  real, dimension(klon) :: alb_lu, rug_lu
 !
 ! quelques variables pour netcdf
@@ -2220 +2283 @@
     lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
     jour_lu_sur = jour - 1
-    allocate(alb_lu(klon))
-    allocate(rug_lu(klon))
+    allocate(alb_lu_p(klon2))
+    allocate(rug_lu_p(klon2))
   endif
 
@@ -2232 +2295 @@
 ! Tester d'abord si c'est le moment de lire le fichier
   if (mod(itime-1, lmt_pas) == 0 .and. .not. deja_lu_sur) then
+  
+  if (phy_rank==0) then
 !
 ! Ouverture du fichier
@@ -2289 +2354 @@
 !
     ierr = NF_CLOSE(nid)
+
+
+  endif  !! phyrank
+
+    call ScatterField(alb_lu,alb_lu_p,1)
+    call ScatterField(rug_lu,rug_lu_p,1)
+
     deja_lu_sur = .true.
     jour_lu_sur = jour
@@ -2297 +2369 @@
 !!$  lmt_alb(:) = 0.0
 !!$  lmt_rug(:) = 0.0
-  lmt_alb(:) = 999999.
-  lmt_rug(:) = 999999.
+ 
+  lmt_alb_p(:) = 999999.
+  lmt_rug_p(:) = 999999.
   DO ii = 1, knon
-    lmt_alb(ii) = alb_lu(knindex(ii))
-    lmt_rug(ii) = rug_lu(knindex(ii))
+    lmt_alb_p(ii) = alb_lu_p(knindex(ii))
+    lmt_rug_p(ii) = rug_lu_p(knindex(ii))
   enddo