Ignore:
Timestamp:
07/26/12 15:25:40 (12 years ago)
Author:
ymipsl
Message:

Implementation of parallelism
implementation of iterative laplacian for dissipation

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/write_field.f90

    r21 r26  
    66    INTEGER :: size 
    77    INTEGER,POINTER :: nc_id(:) 
     8    INTEGER :: displ 
    89  END TYPE ncvar 
    910 
    … …  
    3738      enddo 
    3839    end function GetFieldIndex 
    39   
    40  
    41        
    42     subroutine WriteField_gen(name,Field,dimx,dimy,dimz) 
    43     implicit none 
    44 !    include 'netcdf.inc' 
    45       character(len=*) :: name 
    46       integer :: dimx,dimy,dimz 
    47       real,dimension(dimx,dimy,dimz) :: Field 
    48       integer,dimension(dimx*dimy*dimz) :: ndex 
    49       integer :: status 
    50       integer :: index 
    51       integer :: start(4) 
    52       integer :: count(4) 
    53        
    54             
     40     
     41    SUBROUTINE Writefield(name_in,field,nind) 
     42    USE domain_mod 
     43    USE field_mod 
     44    USE transfert_mpi_mod 
     45    USE dimensions 
     46    USE mpipara 
     47    IMPLICIT NONE   
     48     CHARACTER(LEN=*),INTENT(IN) :: name_in 
     49      TYPE(t_field),POINTER :: field(:) 
     50      INTEGER,OPTIONAL,INTENT(IN) :: nind 
     51      TYPE(t_field),POINTER :: field_glo(:) 
     52       
     53      IF (field(1)%ndim==2) THEN 
     54        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type) 
     55      ELSE IF (field(1)%ndim==3) THEN 
     56        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3)  
     57      ELSE IF (field(1)%ndim==4) THEN 
     58        CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4) 
     59      ENDIF 
     60       
     61      CALL gather_field(field,field_glo) 
     62       
     63      IF (mpi_rank==0) THEN 
     64        IF (PRESENT(nind)) THEN 
     65         CALL writefield_gen(name_in,field_glo,domain_glo,nind) 
     66        ELSE 
     67         CALL writefield_gen(name_in,field_glo,domain_glo,1,ndomain_glo) 
     68        ENDIF 
     69      ENDIF 
     70       
     71      CALL deallocate_field(field_glo) 
     72       
     73   END SUBROUTINE writefield 
     74    
     75!   SUBROUTINE Writefield(name_in,field,nind) 
     76!   USE netcdf 
     77!   USE domain_mod 
     78!   use field_mod 
     79!   USE dimensions 
     80!   USE geometry 
     81!   IMPLICIT NONE 
     82!     CHARACTER(LEN=*),INTENT(IN) :: name_in 
     83!     TYPE(t_field),POINTER :: field(:) 
     84!     INTEGER,OPTIONAL,INTENT(IN) :: nind 
     85!     REAL(r8),ALLOCATABLE :: field_val2d(:) 
     86!     REAL(r8),ALLOCATABLE :: field_val3d(:,:) 
     87!     REAL(r8),ALLOCATABLE :: field_val4d(:,:,:) 
     88!     TYPE(t_domain),POINTER :: d 
     89!     INTEGER :: Index 
     90!     INTEGER :: ind,i,j,k,n,ncell,q 
     91!     INTEGER :: iie,jje,iin,jjn 
     92!     INTEGER :: status 
     93!     CHARACTER(len=255) :: name 
     94!     CHARACTER(len=255) :: str_ind 
     95!     INTEGER :: ind_b,ind_e 
     96!     INTEGER :: halo_size 
     97!     LOGICAL :: single 
     98!      
     99!      
     100!     name=TRIM(ADJUSTL(name_in)) 
     101 
     102!     IF (PRESENT(nind)) THEN 
     103!       name=TRIM(name)//"_"//TRIM(int2str(nind)) 
     104!       PRINT *,"NAME",nind,int2str(nind),name 
     105!       ind_b=nind 
     106!       ind_e=nind 
     107!       halo_size=1 
     108!       single=.TRUE. 
     109!     ELSE 
     110!       ind_b=1 
     111!       ind_e=ndomain 
     112!       halo_size=0 
     113!       single=.FALSE. 
     114!     ENDIF       
     115 
     116!     Index=GetFieldIndex(name) 
     117!     if (Index==-1) then 
     118!       call create_header(name,field,nind) 
     119!       Index=GetFieldIndex(name) 
     120!     else 
     121!       FieldIndex(Index)=FieldIndex(Index)+1. 
     122!     endif 
     123!      
     124!     IF (Field(ind_b)%field_type==field_T) THEN 
     125!       ncell=1 
     126!       DO ind=ind_b,ind_e 
     127!         d=>domain(ind) 
     128!         IF (Field(ind)%field_type/=field_T) THEN 
     129!           PRINT *,"Writefield, grille non geree" 
     130!           RETURN 
     131!         ENDIF 
     132 
     133!       n=0 
     134!       DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     135!         DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     136!           IF (d%own(i,j) .OR. single) n=n+1 
     137!         ENDDO 
     138!       ENDDO 
     139 
     140!       IF (field(ind)%ndim==2) THEN 
     141!         ALLOCATE(Field_val2d(n)) 
     142!         n=0 
     143!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     144!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     145!             k=d%iim*(j-1)+i 
     146!             IF (d%own(i,j) .OR. single) THEN 
     147!               n=n+1 
     148!               Field_val2d(n)=field(ind)%rval2d(k) 
     149!             ENDIF 
     150!           ENDDO 
     151!         ENDDO 
     152!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  & 
     153!                             start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     154!         DEALLOCATE(field_val2d) 
     155!       ELSE IF (field(ind)%ndim==3) THEN 
     156!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2))) 
     157!         n=0 
     158!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     159!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     160!             k=d%iim*(j-1)+i 
     161!             IF (d%own(i,j) .OR. single) THEN 
     162!               n=n+1 
     163!               Field_val3d(n,:)=field(ind)%rval3d(k,:) 
     164!             ENDIF 
     165!           ENDDO 
     166!         ENDDO 
     167!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
     168!                              count=(/n,size(field(1)%rval3d,2),1 /)) 
     169!         DEALLOCATE(field_val3d) 
     170!       ELSE IF (field(1)%ndim==4) THEN 
     171 
     172!         DO q=1,FieldVarId(index)%size 
     173!          
     174!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2))) 
     175!           n=0 
     176!           DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     177!             DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     178!               k=d%iim*(j-1)+i 
     179!               IF (d%own(i,j) .OR. single) THEN 
     180!                 n=n+1 
     181!                 Field_val3d(n,:)=field(ind)%rval4d(k,:,q) 
     182!               ENDIF 
     183!             ENDDO 
     184!           ENDDO 
     185!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
     186!                              count=(/n,size(field(1)%rval4d,2),1 /)) 
     187!           DEALLOCATE(field_val3d) 
     188!         ENDDO          
     189!       ENDIF 
     190!        
     191!        PRINT *,NF90_STRERROR(status) 
     192!       ncell=ncell+n 
     193 
     194!    ENDDO 
     195!     
     196!    ELSE IF (Field(ind_b)%field_type==field_Z) THEN 
     197!       ncell=1 
     198!       n=0 
     199!       DO ind=ind_b,ind_e 
     200!         d=>domain(ind) 
     201!         CALL swap_geometry(ind) 
     202!         CALL swap_dimensions(ind) 
     203!  
     204!         n=0 
     205!         DO j=jj_begin+1,jj_end 
     206!           DO i=ii_begin,ii_end-1 
     207!             n=n+1 
     208!           ENDDO 
     209!         ENDDO 
     210 
     211!         DO j=jj_begin,jj_end-1 
     212!           DO i=ii_begin+1,ii_end 
     213!             n=n+1 
     214!           ENDDO 
     215!         ENDDO 
     216 
     217!       IF (field(ind)%ndim==2) THEN 
     218!         ALLOCATE(Field_val2d(n)) 
     219 
     220!         n=0 
     221!         DO j=jj_begin+1,jj_end 
     222!           DO i=ii_begin,ii_end-1 
     223!             n=n+1 
     224!             k=iim*(j-1)+i 
     225!             Field_val2d(n)=field(ind)%rval2d(k+z_down) 
     226!           ENDDO 
     227!         ENDDO 
     228 
     229!         DO j=jj_begin,jj_end-1 
     230!           DO i=ii_begin+1,ii_end 
     231!             n=n+1 
     232!             k=iim*(j-1)+i 
     233!             Field_val2d(n)=field(ind)%rval2d(k+z_up) 
     234!           ENDDO 
     235!         ENDDO 
     236 
     237!         status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       & 
     238!                             Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     239!         DEALLOCATE(field_val2d) 
     240 
     241!       ELSE IF (field(ind)%ndim==3) THEN 
     242!         ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2))) 
     243!         n=0 
     244!         DO j=jj_begin+1,jj_end 
     245!           DO i=ii_begin,ii_end-1 
     246!             n=n+1 
     247!             k=iim*(j-1)+i 
     248!             Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:) 
     249!           ENDDO 
     250!         ENDDO 
     251 
     252!         DO j=jj_begin,jj_end-1 
     253!           DO i=ii_begin+1,ii_end 
     254!             n=n+1 
     255!             k=iim*(j-1)+i 
     256!             Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:) 
     257!           ENDDO 
     258!         ENDDO 
     259!          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
     260!                              count=(/n,size(field(1)%rval3d,2),1 /)) 
     261!         DEALLOCATE(field_val3d) 
     262!       ELSE IF (field(1)%ndim==4) THEN 
     263 
     264!         DO q=1,FieldVarId(index)%size 
     265!           ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2))) 
     266!           n=0 
     267!           DO j=jj_begin+1,jj_end 
     268!             DO i=ii_begin,ii_end-1 
     269!               n=n+1 
     270!               k=iim*(j-1)+i 
     271!               Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q) 
     272!             ENDDO 
     273!           ENDDO 
     274 
     275!           DO j=jj_begin,jj_end-1 
     276!             DO i=ii_begin+1,ii_end 
     277!               n=n+1 
     278!               k=iim*(j-1)+i 
     279!               Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q) 
     280!             ENDDO 
     281!           ENDDO 
     282 
     283!           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,1,FieldIndex(Index) /),   & 
     284!                               count=(/n,size(field(1)%rval4d,2),1 /)) 
     285!           DEALLOCATE(field_val3d) 
     286!         ENDDO 
     287!       ENDIF 
     288!        
     289!        PRINT *,NF90_STRERROR(status) 
     290!       ncell=ncell+n 
     291 
     292!    ENDDO 
     293!     
     294!    ENDIF 
     295!    status=NF90_SYNC(FieldId(Index)) 
     296!      
     297!   END SUBROUTINE Writefield 
     298 
     299 
     300    SUBROUTINE Writefield_gen(name_in, field, domain_type, ind_b_in, ind_e_in ) 
     301    USE netcdf_mod 
     302    USE domain_mod 
     303    USE field_mod 
     304!    USE dimensions 
     305!    USE geometry 
     306    IMPLICIT NONE 
     307      CHARACTER(LEN=*),INTENT(IN) :: name_in 
     308      TYPE(t_field), POINTER :: field(:) 
     309      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:) 
     310      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in 
     311      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in 
     312      REAL(r8),ALLOCATABLE :: field_val2d(:) 
     313      REAL(r8),ALLOCATABLE :: field_val3d(:,:) 
     314      REAL(r8),ALLOCATABLE :: field_val4d(:,:,:) 
     315      TYPE(t_domain),POINTER :: d 
     316      INTEGER :: Index 
     317      INTEGER :: ind,i,j,k,n,ncell,q 
     318      INTEGER :: iie,jje,iin,jjn 
     319      INTEGER :: status 
     320      CHARACTER(len=255) :: name 
     321      CHARACTER(len=255) :: str_ind 
     322      INTEGER :: ind_b,ind_e 
     323      INTEGER :: halo_size 
     324      LOGICAL :: single 
     325       
     326       
     327      name=TRIM(ADJUSTL(name_in)) 
     328 
     329      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN 
     330        name=TRIM(name)//"_"//TRIM(int2str(ind_b)) 
     331        ind_b=ind_b_in 
     332        ind_e=ind_b_in 
     333        halo_size=1 
     334        single=.TRUE. 
     335      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN 
     336        name=TRIM(name)//"_"//TRIM(int2str(ind_e)) 
     337        ind_b=ind_e_in 
     338        ind_e=ind_e_in 
     339        halo_size=1 
     340        single=.TRUE. 
     341      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN 
     342        ind_b=ind_b_in 
     343        ind_e=ind_e_in 
     344        halo_size=0 
     345        single=.FALSE. 
     346      ELSE 
     347        halo_size=0 
     348        ind_b=1 
     349        ind_e=ndomain 
     350        single=.FALSE. 
     351      ENDIF       
     352       
    55353      Index=GetFieldIndex(name) 
    56354      if (Index==-1) then 
    57 !        call CreateNewField(name,dimx,dimy,dimz) 
    58         Index=GetFieldIndex(name) 
     355        call create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in) 
     356        Index=GetFieldIndex(name) 
    59357      else 
    60358        FieldIndex(Index)=FieldIndex(Index)+1. 
    61359      endif 
    62360       
    63       start(1)=1 
    64       start(2)=1 
    65       start(3)=1 
    66       start(4)=FieldIndex(Index) 
    67  
    68       count(1)=dimx 
    69       count(2)=dimy 
    70       count(3)=dimz 
    71       count(4)=1 
    72  
    73 !      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field) 
    74 !      status = NF_SYNC(FieldId(Index)) 
    75        
    76     end subroutine WriteField_gen 
    77  
    78  
    79     SUBROUTINE Writefield(name_in,field,nind) 
    80     USE netcdf 
     361      IF (Field(ind_b)%field_type==field_T) THEN 
     362 
     363        ncell=0 
     364        DO ind=ind_b,ind_e 
     365          d=>domain_type(ind) 
     366          DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     367            DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     368              IF (d%assign_domain(i,j)==ind .OR. single) ncell=ncell+1 
     369            ENDDO 
     370          ENDDO 
     371        ENDDO 
     372         
     373        IF (field(1)%ndim==2) THEN 
     374          ALLOCATE(Field_val2d(ncell)) 
     375          n=0 
     376          DO ind=ind_b,ind_e 
     377            d=>domain_type(ind) 
     378            DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     379              DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     380                k=d%iim*(j-1)+i 
     381                IF (d%assign_domain(i,j)==ind .OR. single) THEN 
     382                  n=n+1 
     383                  Field_val2d(n)=field(ind)%rval2d(k) 
     384                ENDIF 
     385              ENDDO 
     386            ENDDO 
     387          ENDDO 
     388          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  & 
     389                              start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /)) 
     390          DEALLOCATE(field_val2d) 
     391        ELSE IF (field(1)%ndim==3) THEN 
     392          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2))) 
     393          n=0 
     394          DO ind=ind_b,ind_e 
     395            d=>domain_type(ind) 
     396            DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     397              DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     398                k=d%iim*(j-1)+i 
     399                IF (d%assign_domain(i,j)==ind .OR. single) THEN 
     400                  n=n+1 
     401                  Field_val3d(n,:)=field(ind)%rval3d(k,:) 
     402                ENDIF 
     403              ENDDO 
     404            ENDDO 
     405          ENDDO 
     406            
     407          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   & 
     408                               count=(/ncell,size(field(1)%rval3d,2),1 /)) 
     409          DEALLOCATE(field_val3d) 
     410        ELSE IF (field(1)%ndim==4) THEN 
     411 
     412          DO q=1,FieldVarId(index)%size 
     413           
     414            ALLOCATE(Field_val3d(n,size(field(1)%rval4d,2))) 
     415            n=0 
     416            DO ind=ind_b,ind_e 
     417              d=>domain_type(ind) 
     418              DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     419                DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     420                  k=d%iim*(j-1)+i 
     421                  IF (d%assign_domain(i,j)==ind .OR. single) THEN 
     422                    n=n+1 
     423                    Field_val3d(n,:)=field(ind)%rval4d(k,:,q) 
     424                  ENDIF 
     425                ENDDO 
     426              ENDDO 
     427            ENDDO 
     428             
     429            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   & 
     430                               count=(/ncell,size(field(1)%rval4d,2),1 /)) 
     431            DEALLOCATE(field_val3d) 
     432          ENDDO          
     433        ENDIF 
     434         
     435!        PRINT *,NF90_STRERROR(status) 
     436!        ncell=ncell+n 
     437 
     438!     ENDDO 
     439      
     440     ELSE IF (Field(ind_b)%field_type==field_Z) THEN 
     441 
     442        ncell=0 
     443        DO ind=ind_b,ind_e 
     444          d=>domain_type(ind) 
     445   
     446          DO j=d%jj_begin+1,d%jj_end 
     447            DO i=d%ii_begin,d%ii_end-1 
     448              ncell=ncell+1 
     449            ENDDO 
     450          ENDDO 
     451 
     452          DO j=d%jj_begin,d%jj_end-1 
     453            DO i=d%ii_begin+1,d%ii_end 
     454              ncell=ncell+1 
     455            ENDDO 
     456          ENDDO 
     457        ENDDO 
     458 
     459        IF (field(1)%ndim==2) THEN 
     460          ALLOCATE(Field_val2d(ncell)) 
     461 
     462          n=0 
     463           
     464          DO ind=ind_b,ind_e 
     465            d=>domain_type(ind) 
     466            DO j=d%jj_begin+1,d%jj_end 
     467              DO i=d%ii_begin,d%ii_end-1 
     468                n=n+1 
     469                k=d%iim*(j-1)+i 
     470                Field_val2d(n)=field(ind)%rval2d(k+d%z_down) 
     471              ENDDO 
     472            ENDDO 
     473 
     474            DO j=d%jj_begin,d%jj_end-1 
     475              DO i=d%ii_begin+1,d%ii_end 
     476                n=n+1 
     477                k=d%iim*(j-1)+i 
     478                Field_val2d(n)=field(ind)%rval2d(k+d%z_up) 
     479              ENDDO 
     480            ENDDO 
     481          ENDDO 
     482           
     483          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       & 
     484                              Field_val2d,start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /)) 
     485          DEALLOCATE(field_val2d) 
     486 
     487        ELSE IF (field(1)%ndim==3) THEN 
     488          ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2))) 
     489          n=0 
     490          DO ind=ind_b,ind_e 
     491            d=>domain_type(ind) 
     492            DO j=d%jj_begin+1,d%jj_end 
     493              DO i=d%ii_begin,d%ii_end-1 
     494                n=n+1 
     495                k=d%iim*(j-1)+i 
     496                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_down,:) 
     497              ENDDO 
     498            ENDDO 
     499 
     500            DO j=d%jj_begin,d%jj_end-1 
     501              DO i=d%ii_begin+1,d%ii_end 
     502                n=n+1 
     503                k=d%iim*(j-1)+i 
     504                Field_val3d(n,:)=field(ind)%rval3d(k+d%z_up,:) 
     505              ENDDO 
     506            ENDDO 
     507          ENDDO 
     508           
     509          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /),   & 
     510                              count=(/ncell,size(field(1)%rval3d,2),1 /)) 
     511          DEALLOCATE(field_val3d) 
     512         
     513        ELSE IF (field(1)%ndim==4) THEN 
     514 
     515          DO q=1,FieldVarId(index)%size 
     516            ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2))) 
     517            n=0 
     518            DO ind=ind_b,ind_e 
     519              d=>domain_type(ind) 
     520              DO j=d%jj_begin+1,d%jj_end 
     521                DO i=d%ii_begin,d%ii_end-1 
     522                  n=n+1 
     523                  k=d%iim*(j-1)+i 
     524                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_down,:,q) 
     525                ENDDO 
     526              ENDDO 
     527 
     528              DO j=d%jj_begin,d%jj_end-1 
     529                DO i=d%ii_begin+1,d%ii_end 
     530                  n=n+1 
     531                  k=d%iim*(j-1)+i 
     532                  Field_val3d(n,:)=field(ind)%rval4d(k+d%z_up,:,q) 
     533                ENDDO 
     534              ENDDO 
     535            ENDDO 
     536 
     537            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1,FieldIndex(Index) /),   & 
     538                                count=(/ncell,size(field(1)%rval4d,2),1 /)) 
     539            DEALLOCATE(field_val3d) 
     540          ENDDO 
     541        ENDIF 
     542         
     543!        PRINT *,NF90_STRERROR(status) 
     544!        ncell=ncell+n 
     545! 
     546!     ENDDO 
     547      
     548     ENDIF 
     549     status=NF90_SYNC(FieldId(Index)) 
     550       
     551    END SUBROUTINE Writefield_gen 
     552 
     553       
     554 
     555    SUBROUTINE Writefield_mpi(name_in,field,nind) 
     556    USE netcdf_mod 
    81557    USE domain_mod 
    82558    use field_mod 
    … …  
    92568      TYPE(t_domain),POINTER :: d 
    93569      INTEGER :: Index 
    94       INTEGER :: ind,i,j,k,n,ncell,q 
     570      INTEGER :: ind,i,j,l,k,n,ncell,q 
    95571      INTEGER :: iie,jje,iin,jjn 
    96572      INTEGER :: status 
    … …  
    100576      INTEGER :: halo_size 
    101577      LOGICAL :: single 
     578      INTEGER :: displ 
    102579       
    103580       
    … …  
    120597      Index=GetFieldIndex(name) 
    121598      if (Index==-1) then 
    122         call create_header(name,field,nind) 
     599        call create_header_mpi(name,field,nind) 
    123600        Index=GetFieldIndex(name) 
    124601      else 
    … …  
    142619        ENDDO 
    143620 
     621        displ=FieldVarId(index)%displ 
     622         
    144623        IF (field(ind)%ndim==2) THEN 
    145624          ALLOCATE(Field_val2d(n)) 
    … …  
    155634          ENDDO 
    156635          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  & 
    157                               start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     636                              start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /)) 
    158637          DEALLOCATE(field_val2d) 
    159638        ELSE IF (field(ind)%ndim==3) THEN 
    … …  
    169648            ENDDO 
    170649          ENDDO 
    171            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
    172                                count=(/n,size(field(1)%rval3d,2),1 /)) 
     650!           DO l=1,size(field(ind)%rval3d,2) 
     651            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ displ+ncell,1,FieldIndex(Index) /),   & 
     652                               count=(/n,size(field(ind)%rval3d,2),1 /)) 
     653!           ENDDO 
    173654          DEALLOCATE(field_val3d) 
    174655        ELSE IF (field(1)%ndim==4) THEN 
    … …  
    186667                ENDIF 
    187668              ENDDO 
    188             ENDDO 
    189             status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
    190                                count=(/n,size(field(1)%rval4d,2),1 /)) 
     669             ENDDO 
     670!            DO l=1,size(field(ind)%rval4d,2) 
     671            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d(:,l),start=(/ displ+ncell,l,FieldIndex(Index) /),   & 
     672                               count=(/n,size(field(ind)%rval4d,2),1 /)) 
     673!            ENDDO 
    191674            DEALLOCATE(field_val3d) 
    192675          ENDDO          
    … …  
    219702          ENDDO 
    220703 
     704        displ=FieldVarId(index)%displ 
     705 
    221706        IF (field(ind)%ndim==2) THEN 
    222707          ALLOCATE(Field_val2d(n)) 
    … …  
    240725 
    241726          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       & 
    242                               Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     727                              Field_val2d,start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /)) 
    243728          DEALLOCATE(field_val2d) 
    244729 
    … …  
    261746            ENDDO 
    262747          ENDDO 
    263            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /),   & 
    264                                count=(/n,size(field(1)%rval3d,2),1 /)) 
     748!           DO l=1,size(field(ind)%rval3d,2) 
     749           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ displ+ncell,1,FieldIndex(Index) /),   & 
     750                               count=(/n,size(field(ind)%rval3d,2),1 /)) 
     751!           ENDDO 
    265752          DEALLOCATE(field_val3d) 
    266753        ELSE IF (field(1)%ndim==4) THEN 
    … …  
    285772            ENDDO 
    286773 
    287             status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,1,FieldIndex(Index) /),   & 
    288                                 count=(/n,size(field(1)%rval4d,2),1 /)) 
     774!            DO l=1,size(field(ind)%rval4d,2) 
     775 
     776            status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ displ+ncell,1,FieldIndex(Index) /),   & 
     777                                count=(/n,size(field(ind)%rval4d,2),1 /)) 
     778!            ENDDO 
    289779            DEALLOCATE(field_val3d) 
    290780          ENDDO 
    … …  
    299789     status=NF90_SYNC(FieldId(Index)) 
    300790       
    301     END SUBROUTINE Writefield 
    302        
     791    END SUBROUTINE Writefield_mpi 
     792     
     793     
    303794            
    304     SUBROUTINE Create_header(name,field,nind) 
    305     USE netcdf 
     795!   SUBROUTINE Create_header(name,field,nind) 
     796!   USE netcdf 
     797!   USE field_mod 
     798!   USE domain_mod 
     799!   USE spherical_geom_mod 
     800!   USE dimensions 
     801!   USE geometry 
     802!   IMPLICIT NONE 
     803!     CHARACTER(LEN=*) :: name 
     804!     TYPE(t_field),POINTER :: field(:) 
     805!     INTEGER,OPTIONAL,INTENT(IN) :: nind 
     806!     INTEGER :: ncell 
     807!     INTEGER :: nvert 
     808!     REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:) 
     809!     TYPE(t_domain),POINTER :: d 
     810!     INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId 
     811!     INTEGER :: dim3id,dim4id 
     812!     INTEGER :: status 
     813!     INTEGER :: ind,i,j,k,n,q 
     814!     INTEGER :: iie,jje,iin,jjn 
     815!     INTEGER :: ind_b,ind_e 
     816!     INTEGER :: halo_size 
     817!     LOGICAL :: single  
     818!     INTEGER :: nij 
     819!          
     820!     NbField=NbField+1 
     821!     FieldName(NbField)=TRIM(ADJUSTL(name)) 
     822!     FieldIndex(NbField)=1 
     823!      
     824!     IF (PRESENT(nind)) THEN 
     825!       ind_b=nind 
     826!       ind_e=nind 
     827!       halo_size=1 
     828!       single=.TRUE. 
     829!     ELSE 
     830!       ind_b=1 
     831!       ind_e=ndomain 
     832!       halo_size=0 
     833!       single=.FALSE. 
     834!     ENDIF 
     835!      
     836!     ncell=0 
     837!      
     838!     IF (Field(ind_b)%field_type==field_T) THEN 
     839!       nvert=6 
     840!        
     841!       DO ind=ind_b,ind_e 
     842!         d=>domain(ind) 
     843!        
     844!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     845!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     846!             IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1 
     847!           ENDDO 
     848!         ENDDO 
     849 
     850!       END DO 
     851!      
     852!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     853!       FieldId(NbField)=ncid 
     854!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     855!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
     856 
     857!       IF (Field(ind_b)%ndim==2)  THEN 
     858!         FieldVarId(NbField)%size=1 
     859!         ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     860!       ELSE IF (Field(ind_b)%ndim==3)  THEN 
     861!         FieldVarId(NbField)%size=1 
     862!         ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     863!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id) 
     864!       ELSE IF (Field(1)%ndim==4) THEN 
     865!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3) 
     866!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size)) 
     867!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id) 
     868!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id) 
     869!       ENDIF 
     870!      
     871!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId) 
     872!      
     873!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId) 
     874!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
     875!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
     876!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
     877!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId) 
     878!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
     879!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
     880!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
     881!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId) 
     882!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId) 
     883 
     884!       IF (Field(ind_b)%ndim==2) THEN 
     885!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
     886!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     887!       ELSE IF (Field(ind_b)%ndim==3) THEN 
     888!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
     889!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     890!       ELSE IF (Field(ind_b)%ndim==4) THEN 
     891!         DO i=1,FieldVarId(NbField)%size 
     892!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),  & 
     893!                                 FieldVarId(NbField)%nc_id(i)) 
     894!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat") 
     895!         ENDDO         
     896!       ENDIF  
     897!  
     898!      
     899!       status = NF90_ENDDEF(ncid)       
     900 
     901!       ncell=1 
     902!       DO ind=ind_b,ind_e 
     903!         d=>domain(ind) 
     904!  
     905!         n=0 
     906!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     907!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     908!             IF (single .OR. d%own(i,j)) n=n+1 
     909!           ENDDO 
     910!         ENDDO 
     911!          
     912!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n)) 
     913!          
     914!         n=0   
     915!         DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     916!           DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     917!               IF (d%own(i,j) .OR. single) THEN 
     918!               n=n+1 
     919!               CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n)) 
     920!               lon(n)=lon(n)*180/Pi 
     921!               lat(n)=lat(n)*180/Pi 
     922!               DO k=0,5 
     923!                 CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n)) 
     924!                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     925!                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     926!               ENDDO 
     927!             ENDIF 
     928!           ENDDO 
     929!         ENDDO 
     930!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /)) 
     931!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /)) 
     932!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     933!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     934!  
     935!         ncell=ncell+n 
     936!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat) 
     937!     END DO  
     938 
     939!   ELSE IF (Field(ind_b)%field_type==field_Z) THEN 
     940!       nvert=3 
     941!       DO ind=ind_b,ind_e 
     942!         d=>domain(ind) 
     943!        
     944!         DO j=d%jj_begin+1,d%jj_end 
     945!           DO i=d%ii_begin,d%ii_end-1 
     946!             ncell=ncell+1 
     947!           ENDDO 
     948!         ENDDO 
     949 
     950!         DO j=d%jj_begin,d%jj_end-1 
     951!           DO i=d%ii_begin+1,d%ii_end 
     952!             ncell=ncell+1 
     953!           ENDDO 
     954!         ENDDO 
     955 
     956!       END DO 
     957!      
     958!       status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     959!       FieldId(NbField)=ncid 
     960!       status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     961!       status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
     962 
     963!       IF (Field(ind_b)%ndim==2)  THEN 
     964!         FieldVarId(NbField)%size=1 
     965!         ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     966!       ELSE IF (Field(ind_b)%ndim==3)  THEN 
     967!         FieldVarId(NbField)%size=1 
     968!         ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     969!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id) 
     970!       ELSE IF (Field(1)%ndim==4) THEN 
     971!         FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3) 
     972!         ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size)) 
     973!         status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id) 
     974!       ENDIF 
     975 
     976 
     977!      
     978!       status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId) 
     979!      
     980!       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId) 
     981!       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
     982!       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
     983!       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
     984!       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId) 
     985!       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
     986!       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
     987!       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
     988!       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId) 
     989!       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId) 
     990 
     991 
     992!       IF (Field(ind_b)%ndim==2) THEN 
     993!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
     994!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     995!       ELSE IF (Field(ind_b)%ndim==3) THEN 
     996!         status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
     997!         status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     998!       ELSE IF (Field(ind_b)%ndim==4) THEN 
     999!         DO q=1,FieldVarId(NbField)%size 
     1000!           status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,             & 
     1001!                                 (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 
     1002!           status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat") 
     1003!         ENDDO         
     1004!       ENDIF  
     1005!        
     1006!       status = NF90_ENDDEF(ncid)       
     1007 
     1008!       ncell=1 
     1009!       DO ind=ind_b,ind_e 
     1010!         d=>domain(ind) 
     1011!         CALL swap_geometry(ind) 
     1012!         CALL swap_dimensions(ind) 
     1013!  
     1014!         n=0 
     1015!         DO j=jj_begin+1,jj_end 
     1016!           DO i=ii_begin,ii_end-1 
     1017!             n=n+1 
     1018!           ENDDO 
     1019!         ENDDO 
     1020 
     1021!         DO j=jj_begin,jj_end-1 
     1022!           DO i=ii_begin+1,ii_end 
     1023!             n=n+1 
     1024!           ENDDO 
     1025!         ENDDO 
     1026 
     1027!        ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n)) 
     1028!          
     1029!         n=0   
     1030!       
     1031!         DO j=jj_begin+1,jj_end 
     1032!           DO i=ii_begin,ii_end-1 
     1033!             nij=(j-1)*iim+i 
     1034!             n=n+1 
     1035!             CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n)) 
     1036!             lon(n)=lon(n)*180/Pi 
     1037!!             IF (lon(n)<0) lon(n)=lon(n)+360 
     1038!             lat(n)=lat(n)*180/Pi 
     1039!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n)) 
     1040!             CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n)) 
     1041!             CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n)) 
     1042 
     1043!             DO k=0,2 
     1044!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     1045!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     1046!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360 
     1047!             ENDDO 
     1048!           ENDDO 
     1049!         ENDDO 
     1050 
     1051!         DO j=jj_begin,jj_end-1 
     1052!           DO i=ii_begin+1,ii_end 
     1053!             nij=(j-1)*iim+i 
     1054!             n=n+1 
     1055!             CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n)) 
     1056!             lon(n)=lon(n)*180/Pi 
     1057!              IF (lon(n)<0) lon(n)=lon(n)+360 
     1058!             lat(n)=lat(n)*180/Pi 
     1059!             CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n)) 
     1060!             CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n)) 
     1061!             CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n)) 
     1062 
     1063!             DO k=0,2 
     1064!               bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     1065!               bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     1066!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360 
     1067!             ENDDO 
     1068!           ENDDO 
     1069!         ENDDO 
     1070!          
     1071!          
     1072!         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /)) 
     1073!         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /)) 
     1074!         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     1075!         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     1076!  
     1077!         ncell=ncell+n 
     1078!         DEALLOCATE(lon,lat,bounds_lon,bounds_lat) 
     1079!     END DO           
     1080!   ENDIF 
     1081 
     1082 
     1083!      
     1084!      status = NF90_CLOSE(ncid) 
     1085 
     1086!   END SUBROUTINE Create_Header 
     1087 
     1088 
     1089 
     1090    
     1091    SUBROUTINE Create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in) 
     1092    USE netcdf_mod 
     1093    USE field_mod 
     1094    USE domain_mod 
     1095    USE metric 
     1096    USE spherical_geom_mod 
     1097!    USE dimensions 
     1098!    USE geometry 
     1099    IMPLICIT NONE 
     1100      CHARACTER(LEN=*),INTENT(IN) :: name_in 
     1101      TYPE(t_field),POINTER :: field(:) 
     1102      TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:) 
     1103      INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in 
     1104      INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in 
     1105      INTEGER :: ncell 
     1106      INTEGER :: nvert 
     1107      REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:) 
     1108      TYPE(t_domain),POINTER :: d 
     1109      INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId 
     1110      INTEGER :: dim3id,dim4id 
     1111      INTEGER :: status 
     1112      INTEGER :: ind,i,j,k,n,q 
     1113      INTEGER :: iie,jje,iin,jjn 
     1114      INTEGER :: ind_b,ind_e 
     1115      INTEGER :: halo_size 
     1116      LOGICAL :: single  
     1117      INTEGER :: nij 
     1118      CHARACTER(LEN=255) :: name 
     1119       
     1120             
     1121      name=TRIM(ADJUSTL(name_in)) 
     1122 
     1123      IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN 
     1124        name=TRIM(name)//"_"//TRIM(int2str(ind_b)) 
     1125        ind_b=ind_b_in 
     1126        ind_e=ind_b_in 
     1127        halo_size=1 
     1128        single=.TRUE. 
     1129      ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN 
     1130        name=TRIM(name)//"_"//TRIM(int2str(ind_e)) 
     1131        ind_b=ind_e_in 
     1132        ind_e=ind_e_in 
     1133        halo_size=1 
     1134        single=.TRUE. 
     1135      ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN 
     1136        ind_b=ind_b_in 
     1137        ind_e=ind_e_in 
     1138        halo_size=0 
     1139        single=.FALSE. 
     1140      ELSE 
     1141        halo_size=0 
     1142        ind_b=1 
     1143        ind_e=ndomain 
     1144        single=.FALSE. 
     1145      ENDIF       
     1146                 
     1147      NbField=NbField+1 
     1148      FieldName(NbField)=TRIM(ADJUSTL(name)) 
     1149      FieldIndex(NbField)=1 
     1150       
     1151      ncell=0 
     1152       
     1153      IF (Field(ind_b)%field_type==field_T) THEN 
     1154        nvert=6 
     1155         
     1156        DO ind=ind_b,ind_e 
     1157          d=>domain_type(ind) 
     1158         
     1159          DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     1160            DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     1161              IF (single .OR. d%assign_domain(i,j)==ind) ncell=ncell+1 
     1162            ENDDO 
     1163          ENDDO 
     1164 
     1165        END DO 
     1166       
     1167        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     1168        FieldId(NbField)=ncid 
     1169        status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     1170        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
     1171 
     1172        IF (Field(ind_b)%ndim==2)  THEN 
     1173          FieldVarId(NbField)%size=1 
     1174          ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     1175        ELSE IF (Field(ind_b)%ndim==3)  THEN 
     1176          FieldVarId(NbField)%size=1 
     1177          ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     1178          status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id) 
     1179        ELSE IF (Field(1)%ndim==4) THEN 
     1180          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3) 
     1181          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size)) 
     1182          status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id) 
     1183!          status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id) 
     1184        ENDIF 
     1185       
     1186        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId) 
     1187       
     1188        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId) 
     1189        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
     1190        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
     1191        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
     1192        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId) 
     1193        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
     1194        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
     1195        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
     1196        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId) 
     1197        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId) 
     1198 
     1199        IF (Field(ind_b)%ndim==2) THEN 
     1200          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
     1201          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1202        ELSE IF (Field(ind_b)%ndim==3) THEN 
     1203          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
     1204          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1205        ELSE IF (Field(ind_b)%ndim==4) THEN 
     1206          DO i=1,FieldVarId(NbField)%size 
     1207            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),  & 
     1208                                  FieldVarId(NbField)%nc_id(i)) 
     1209            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat") 
     1210          ENDDO         
     1211        ENDIF  
     1212   
     1213       
     1214        status = NF90_ENDDEF(ncid)       
     1215 
     1216!        ncell=1 
     1217!        DO ind=ind_b,ind_e 
     1218!          d=>domain_type(ind) 
     1219   
     1220!          n=0 
     1221!          DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     1222!            DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     1223!              IF (single .OR. d%assign_domain(i,j)==ind) n=n+1 
     1224!            ENDDO 
     1225!          ENDDO 
     1226           
     1227         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell)) 
     1228           
     1229         n=0   
     1230         DO ind=ind_b,ind_e 
     1231           d=>domain_type(ind) 
     1232           DO j=d%jj_begin-halo_size,d%jj_end+halo_size 
     1233             DO i=d%ii_begin-halo_size,d%ii_end+halo_size 
     1234               IF (d%assign_domain(i,j)==ind .OR. single) THEN 
     1235                 n=n+1 
     1236                 CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n)) 
     1237                 lon(n)=lon(n)*180/Pi 
     1238                 lat(n)=lat(n)*180/Pi 
     1239                 DO k=0,5 
     1240                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n)) 
     1241                   bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     1242                   bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     1243                 ENDDO 
     1244               ENDIF 
     1245             ENDDO 
     1246           ENDDO 
     1247         ENDDO 
     1248         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /)) 
     1249         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /)) 
     1250         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /)) 
     1251         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /)) 
     1252   
     1253!         ncell=ncell+n 
     1254         DEALLOCATE(lon,lat,bounds_lon,bounds_lat) 
     1255!      END DO  
     1256 
     1257    ELSE IF (Field(ind_b)%field_type==field_Z) THEN 
     1258        nvert=3 
     1259        DO ind=ind_b,ind_e 
     1260          d=>domain_type(ind) 
     1261         
     1262          DO j=d%jj_begin+1,d%jj_end 
     1263            DO i=d%ii_begin,d%ii_end-1 
     1264              ncell=ncell+1 
     1265            ENDDO 
     1266          ENDDO 
     1267 
     1268          DO j=d%jj_begin,d%jj_end-1 
     1269            DO i=d%ii_begin+1,d%ii_end 
     1270              ncell=ncell+1 
     1271            ENDDO 
     1272          ENDDO 
     1273 
     1274        END DO 
     1275       
     1276        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     1277        FieldId(NbField)=ncid 
     1278        status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     1279        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
     1280 
     1281        IF (Field(ind_b)%ndim==2)  THEN 
     1282          FieldVarId(NbField)%size=1 
     1283          ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     1284        ELSE IF (Field(ind_b)%ndim==3)  THEN 
     1285          FieldVarId(NbField)%size=1 
     1286          ALLOCATE(FieldVarId(NbField)%nc_id(1)) 
     1287          status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id) 
     1288        ELSE IF (Field(1)%ndim==4) THEN 
     1289          FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3) 
     1290          ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size)) 
     1291          status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id) 
     1292        ENDIF 
     1293 
     1294 
     1295       
     1296        status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId) 
     1297       
     1298        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId) 
     1299        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
     1300        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
     1301        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
     1302        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId) 
     1303        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
     1304        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
     1305        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
     1306        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId) 
     1307        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId) 
     1308 
     1309 
     1310        IF (Field(ind_b)%ndim==2) THEN 
     1311          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
     1312          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1313        ELSE IF (Field(ind_b)%ndim==3) THEN 
     1314          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
     1315          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1316        ELSE IF (Field(ind_b)%ndim==4) THEN 
     1317          DO q=1,FieldVarId(NbField)%size 
     1318            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,             & 
     1319                                  (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 
     1320            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat") 
     1321          ENDDO         
     1322        ENDIF  
     1323         
     1324        status = NF90_ENDDEF(ncid)       
     1325 
     1326!        ncell=1 
     1327!        DO ind=ind_b,ind_e 
     1328!          d=>domain_type(ind) 
     1329!   
     1330!          n=0 
     1331!          DO j=d%jj_begin+1,d%jj_end 
     1332!            DO i=d%ii_begin,d%ii_end-1 
     1333!              n=n+1 
     1334!            ENDDO 
     1335!          ENDDO 
     1336! 
     1337!          DO j=d%jj_begin,d%jj_end-1 
     1338!            DO i=d%ii_begin+1,d%ii_end 
     1339!              n=n+1 
     1340!            ENDDO 
     1341!          ENDDO 
     1342 
     1343!         ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n)) 
     1344         ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell)) 
     1345           
     1346         n=0   
     1347        
     1348         DO ind=ind_b,ind_e 
     1349           d=>domain_type(ind) 
     1350           DO j=d%jj_begin+1,d%jj_end 
     1351             DO i=d%ii_begin,d%ii_end-1 
     1352               nij=(j-1)*d%iim+i 
     1353               n=n+1 
     1354               CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(n),lat(n)) 
     1355               lon(n)=lon(n)*180/Pi 
     1356 !              IF (lon(n)<0) lon(n)=lon(n)+360 
     1357               lat(n)=lat(n)*180/Pi 
     1358!               CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n)) 
     1359!               CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n)) 
     1360!               CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n)) 
     1361 
     1362               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n)) 
     1363               CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,n), bounds_lat(1,n)) 
     1364               CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,n), bounds_lat(2,n)) 
     1365 
     1366               DO k=0,2 
     1367                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     1368                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     1369!                IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360 
     1370               ENDDO 
     1371             ENDDO 
     1372           ENDDO 
     1373 
     1374           DO j=d%jj_begin,d%jj_end-1 
     1375             DO i=d%ii_begin+1,d%ii_end 
     1376               nij=(j-1)*d%iim+i 
     1377               n=n+1 
     1378!              CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n)) 
     1379               CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(n),lat(n)) 
     1380               lon(n)=lon(n)*180/Pi 
     1381!              IF (lon(n)<0) lon(n)=lon(n)+360 
     1382               lat(n)=lat(n)*180/Pi 
     1383!              CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n)) 
     1384!              CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n)) 
     1385!              CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n)) 
     1386               CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n)) 
     1387               CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,n), bounds_lat(1,n)) 
     1388               CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,n), bounds_lat(2,n)) 
     1389 
     1390               DO k=0,2 
     1391                 bounds_lat(k,n)=bounds_lat(k,n)*180/Pi 
     1392                 bounds_lon(k,n)=bounds_lon(k,n)*180/Pi 
     1393!                 IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360 
     1394               ENDDO 
     1395             ENDDO 
     1396           ENDDO 
     1397         ENDDO  
     1398           
     1399         status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /)) 
     1400         status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /)) 
     1401         status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /)) 
     1402         status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /)) 
     1403   
     1404!          ncell=ncell+n 
     1405          DEALLOCATE(lon,lat,bounds_lon,bounds_lat) 
     1406!      END DO           
     1407    ENDIF 
     1408 
     1409 
     1410       
     1411!      status = NF90_CLOSE(ncid) 
     1412 
     1413    END SUBROUTINE Create_Header_gen 
     1414 
     1415    SUBROUTINE Create_header_mpi(name,field,nind) 
     1416    USE netcdf_mod 
    3061417    USE field_mod 
    3071418    USE domain_mod 
    … …  
    3091420    USE dimensions 
    3101421    USE geometry 
     1422    USE mpi_mod 
     1423    USE mpipara 
    3111424    IMPLICIT NONE 
    3121425      CHARACTER(LEN=*) :: name 
    … …  
    3261439      LOGICAL :: single  
    3271440      INTEGER :: nij 
     1441      INTEGER :: ncell_glo(0:mpi_size-1) 
     1442      INTEGER :: displ, ncell_tot 
     1443       
    3281444           
    3291445      NbField=NbField+1 
    … …  
    3591475        END DO 
    3601476       
    361         status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     1477        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr) 
     1478 
     1479        displ=0 
     1480        DO i=1,mpi_rank 
     1481          displ=displ+ncell_glo(i-1) 
     1482        ENDDO 
     1483        FieldVarId(NbField)%displ=displ 
     1484        ncell_tot=sum(ncell_glo(:)) 
     1485         
     1486        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc', IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid) 
    3621487        FieldId(NbField)=ncid 
    363         status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     1488        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId) 
    3641489        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
    3651490 
    … …  
    3941519          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
    3951520          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1521          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/)) 
    3961522        ELSE IF (Field(ind_b)%ndim==3) THEN 
    3971523          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
    3981524          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1525          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,size(field(ind_b)%rval3d,2),1/)) 
    3991526        ELSE IF (Field(ind_b)%ndim==4) THEN 
    4001527          DO i=1,FieldVarId(NbField)%size 
    … …  
    4021529                                  FieldVarId(NbField)%nc_id(i)) 
    4031530            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat") 
     1531            status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, (/ncell_tot,size(field(ind_b)%rval4d,2),1/)) 
    4041532          ENDDO         
    4051533        ENDIF  
    … …  
    4371565            ENDDO 
    4381566          ENDDO 
    439           status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /)) 
    440           status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /)) 
    441           status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
    442           status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     1567          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /)) 
     1568          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /)) 
     1569          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /)) 
     1570          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /)) 
    4431571   
    4441572          ncell=ncell+n 
    … …  
    4641592 
    4651593        END DO 
    466        
    467         status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
     1594         
     1595        CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr) 
     1596 
     1597        displ=0 
     1598        DO i=1,mpi_rank 
     1599          displ=displ+ncell_glo(i-1) 
     1600        ENDDO 
     1601        FieldVarId(NbField)%displ=displ 
     1602        ncell_tot=sum(ncell_glo(:)) 
     1603               
     1604        status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc',IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid) 
     1605!        status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid) 
    4681606        FieldId(NbField)=ncid 
    469         status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId) 
     1607        status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId) 
    4701608        status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid) 
    4711609 
    … …  
    5021640          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1)) 
    5031641          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1642          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/)) 
    5041643        ELSE IF (Field(ind_b)%ndim==3) THEN 
    5051644          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1)) 
    5061645          status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat") 
     1646          status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,size(field(ind_b)%rval3d,2),1/)) 
    5071647        ELSE IF (Field(ind_b)%ndim==4) THEN 
    5081648          DO q=1,FieldVarId(NbField)%size 
    … …  
    5101650                                  (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 
    5111651            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat") 
     1652           status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, (/ncell_tot,size(field(ind_b)%rval4d,2),1/)) 
    5121653          ENDDO         
    5131654        ENDIF  
    … …  
    5791720           
    5801721           
    581           status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /)) 
    582           status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /)) 
    583           status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
    584           status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /)) 
     1722          status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /)) 
     1723          status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /)) 
     1724          status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /)) 
     1725          status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /)) 
    5851726   
    5861727          ncell=ncell+n 
    … …  
    5931734!      status = NF90_CLOSE(ncid) 
    5941735 
    595     end subroutine Create_Header 
     1736    end subroutine Create_Header_mpi   
    5961737    
    597    
     1738   SUBROUTINE Close_files 
     1739   USE netcdf 
     1740   IMPLICIT NONE 
     1741     INTEGER :: i,k,status 
     1742      
     1743     DO i=1,NbField 
     1744         status=NF90_CLOSE(FieldId(i)) 
     1745     ENDDO 
     1746   END SUBROUTINE  Close_files 
     1747      
     1748      
    5981749  function int2str(int) 
    5991750    implicit none 
Note: See TracChangeset for help on using the changeset viewer.