Changeset 476 for codes/icosagcm/trunk/src

Timestamp:

09/12/16 14:39:01 (8 years ago)

Author:

ymipsl

Message:

Bug fix : read and write restart file was brocken due to new extra dimension to theta_rhodz

YM

Location:

codes/icosagcm/trunk/src

Files:

• etat0_start_file.f90 (modified) (6 diffs)
• write_etat0.f90 (modified) (2 diffs)

codes/icosagcm/trunk/src/etat0_start_file.f90

@@ -14 +14 @@
   USE time_mod
   USE transfert_mod
+  USE omp_para
   IMPLICIT NONE
     TYPE(t_field),POINTER :: f_ps(:)
@@ -23 +24 @@
     TYPE(t_field),POINTER,SAVE :: f_ulon(:)
     TYPE(t_field),POINTER,SAVE :: f_ulat(:)
+    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
 
     LOGICAL :: etat0_start_file_colocated=.FALSE.
@@ -28 +31 @@
 
       CALL getin("etat0_start_file_colocated",etat0_start_file_colocated)  
+      CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
+
 
       IF (.NOT. etat0_start_file_colocated) THEN    
         CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
         CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
-        CALL read_start(itau0,f_ps,f_phis,f_theta_rhodz,f_u, f_q)
+        CALL read_start(itau0,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_q)
         CALL transfert_request(f_ps,req_i1)
         CALL transfert_request(f_phis,req_i1)
-        CALL transfert_request(f_theta_rhodz,req_i1)
+        CALL transfert_request(f_theta_rhodz_1d,req_i1)
         CALL transfert_request(f_q,req_i1)
         CALL transfert_request(f_u,req_e1_vect)
@@ -47 +52 @@
         CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
         CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
-        CALL read_start(itau0,f_ps,f_phis,f_theta_rhodz,f_ulon,f_ulat, f_q)
+        CALL read_start(itau0,f_ps,f_phis,f_theta_rhodz_1d,f_ulon,f_ulat, f_q)
         CALL transfert_request(f_ulat,req_i1)
         CALL transfert_request(f_ulon,req_i1)
@@ -55 +60 @@
         CALL transfert_request(f_ps,req_i1)
         CALL transfert_request(f_phis,req_i1)
-        CALL transfert_request(f_theta_rhodz,req_i1)
+        CALL transfert_request(f_theta_rhodz_1d,req_i1)
         CALL transfert_request(f_q,req_i1)
         CALL transfert_request(f_u,req_e1_vect)
@@ -62 +67 @@
         CALL deallocate_field(f_ulat)
       ENDIF
+
+!$OMP BARRIER    
+    DO ind=1, ndomain
+       IF (.NOT. assigned_domain(ind) .AND. is_omp_level_master) CYCLE
+       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
+       theta_rhodz(:,:,1)=theta_rhodz_1d(:,:)
+    ENDDO
+!$OMP BARRIER    
 
       CALL bcast(itau0)

codes/icosagcm/trunk/src/write_etat0.f90

@@ -10 +10 @@
   USE wind_mod
   USE write_field_mod
+  USE domain_mod
+  USE omp_para
   IMPLICIT NONE
     INTEGER,INTENT(IN)    :: it
@@ -20 +22 @@
     TYPE(t_field),POINTER,SAVE :: f_ulon(:)
     TYPE(t_field),POINTER,SAVE :: f_ulat(:)
+    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
+    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
+    INTEGER :: ind
     
     
     CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
     CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
+    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
 
+!$OMP BARRIER    
+    DO ind=1, ndomain
+       IF (.NOT. assigned_domain(ind) .AND. is_omp_level_master) CYCLE
+       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
+       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
+    ENDDO
+    
     CALL transfert_request(f_u,req_e1_vect)
     CALL un2ulonlat(f_u, f_ulon, f_ulat)
     
-    CALL write_restart(it,f_ps,f_phis,f_theta_rhodz,f_u, f_ulon, f_ulat, f_q)
+    CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q)
 
     CALL deallocate_field(f_ulon)