Changeset 766 for LMDZ4/trunk/libf/phylmd/iophy.F90

Timestamp:

Jun 4, 2007, 4:34:47 PM (17 years ago)

Author:

Laurent Fairhead

Message:

Merge entre la version V3_conv et le HEAD
YM, JG, LF

File:

• LMDZ4/trunk/libf/phylmd/iophy.F90 (modified) (10 diffs)

LMDZ4/trunk/libf/phylmd/iophy.F90

@@ -7 +7 @@
   REAL,private,allocatable,dimension(:),save :: io_lat
   REAL,private,allocatable,dimension(:),save :: io_lon
+  INTEGER, save :: phys_domain_id
   
   INTERFACE histwrite_phy
     MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
   END INTERFACE 
+  
+  REAL,private,allocatable,save,dimension(:,:) :: buffer_omp
 
 contains
@@ -16 +19 @@
   subroutine init_iophy(lat,lon)
   use dimphy
+  use ioipsl
   implicit none
   include 'dimensions90.h'   
     real,dimension(iim),intent(in) :: lon
     real,dimension(jjm+1),intent(in) :: lat
-  
+
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+
+!$OMP MASTER  
     allocate(io_lat(jjm+1))
     io_lat(:)=lat(:)
@@ -31 +44 @@
     ndex2d(:)=0
     ndex3d(:)=0
+    allocate(buffer_omp(klon_mpi,klev))
+    
+    ddid=(/ 1,2 /)
+    dsg=(/ iim, jjm+1 /)
+    dsl=(/ iim, jjphy_nb /)
+    dpf=(/ 1,jjphy_begin /)
+    dpl=(/ iim, jjphy_end /)
+    dhs=(/ iiphy_begin-1,0 /)
+    if (phy_rank==phy_size-1) then
+      dhe=(/0,0/)
+    else
+      dhe=(/ iim-iiphy_end,0 /)  
+    endif
+    
+    call flio_dom_set(phy_size,phy_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'APPLE',phys_domain_id)
 
+!$OMP END MASTER
+!$OMP FLUSH(buffer_omp)
+      
   end subroutine init_iophy
   
@@ -47 +79 @@
     integer,intent(out) :: nhori
     integer,intent(out) :: nid_day
-    
+
+!$OMP MASTER    
     if (monocpu) then
       call histbeg(name,iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
                    1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
     else
-      call histbeg(name//'_'//trim(int2str(phy_rank)),iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
-                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
+      call histbeg(name,iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
+                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
     endif
+!$OMP END MASTER
   
   end subroutine histbeg_phy
@@ -68 +102 @@
     integer, intent(in) :: itau
     real,dimension(klon),intent(in) :: field
-    
-    CALL phy2dyn(field,tmp_tab2d,1)
+
+    CALL GatherField_omp(field,buffer_omp,1)    
+!$OMP MASTER
+    CALL phy2dyn(buffer_omp,tmp_tab2d,1)
     CALL histwrite(nid,name,itau,tmp_tab2d,iim*jjphy_nb,ndex2d)
-    
+!$OMP END MASTER    
   end subroutine histwrite2d_phy
   
@@ -85 +121 @@
     real,dimension(klon,klev),intent(in) :: field
     
-    CALL phy2dyn(field,tmp_tab3d,klev)
+    CALL GatherField_omp(field,buffer_omp,klev)
+!$OMP MASTER
+    CALL phy2dyn(buffer_omp,tmp_tab3d,klev)
     CALL histwrite(nid,name,itau,tmp_tab3d,iim*jjphy_nb*klev,ndex3d)
-    
+!$OMP END MASTER    
   end subroutine histwrite3d_phy
   
@@ -96 +134 @@
   include 'dimensions90.h'
   
-    real,dimension(klon,nlev),intent(in) :: field_phy
+    real,dimension(klon_mpi,nlev),intent(in) :: field_phy
     real,dimension(iim,jjphy_nb,nlev),intent(out) :: field_dyn
     integer,intent(in) :: nlev
@@ -107 +145 @@
         if (jjphy_begin==jjphy_end) then
           field_dyn(:,1,l)=0.
-          field_dyn(iiphy_begin:iiphy_end,1,l)=field_phy(1:klon,l)
+          field_dyn(iiphy_begin:iiphy_end,1,l)=field_phy(1:klon_mpi,l)
         else
         
@@ -115 +153 @@
          else
            field_dyn(:,1,l)=0.
-           next=iim-iiphy_begin+1
+           next=iim-iiphy_begin+2
            field_dyn(iiphy_begin:iim,1,l)=field_phy(1:next-1,l)   
          endif
@@ -125 +163 @@
           
           if (jjphy_end==jjm+1) then
-             field_dyn(:,jjphy_nb,l)=field_phy(klon,l)
+             field_dyn(:,jjphy_nb,l)=field_phy(klon_mpi,l)
           else
            field_dyn(:,jjphy_nb,l)=0.