Changeset 394


Ignore:
Timestamp:
06/02/16 18:57:23 (8 years ago)
Author:
ymipsl
Message:

Switching to XIOS2

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/xios_mod.F90

    r342 r394  
    2121 SUBROUTINE xios_init 
    2222   USE getin_mod 
     23   USE xios 
     24   USE mpipara 
    2325   IMPLICIT NONE 
    24  
    25    using_xios=.TRUE. 
     26    TYPE(xios_context) :: ctx_hdl 
     27 
     28     using_xios=.TRUE. 
     29     CALL xios_context_initialize("icosagcm",comm_icosa) 
     30     CALL xios_get_handle("icosagcm",ctx_hdl) 
     31     CALL xios_set_current_context(ctx_hdl) 
    2632    
    2733 END SUBROUTINE xios_init   
    … …  
    4147 IMPLICIT NONE 
    4248  TYPE(xios_context) :: ctx_hdl 
    43   TYPE(xios_time)      :: dtime 
     49  TYPE(xios_duration)      :: dtime 
    4450  REAL(rstd) :: lev_value(llm) 
    4551  REAL(rstd) :: lev_valuep1(llm+1) 
    … …  
    5157!$OMP BARRIER 
    5258!$OMP MASTER 
    53    CALL xios_context_initialize("icosagcm",comm_icosa) 
     59!   CALL xios_context_initialize("icosagcm",comm_icosa) 
    5460   CALL xios_get_handle("icosagcm",ctx_hdl) 
    5561   CALL xios_set_current_context(ctx_hdl) 
    5662   lev_value(:) = (/ (l,l=1,llm) /)      
    5763   lev_valuep1(:) = (/ (l,l=1,llm+1) /)      
    58    CALL xios_set_axis_attr("lev",size=llm ,value=lev_value) ; 
    59    CALL xios_set_axis_attr("levp1",size=llm+1 ,value=lev_valuep1) ; 
     64   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ; 
     65   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ; 
    6066    
    6167   ncell=0 
    … …  
    104110 
    105111   
    106    CALL xios_set_domain_attr("i",ni_glo=ncell_tot, ibegin=displ+1, ni=ncell) 
    107    CALL xios_set_domain_attr("i", data_dim=1, type='unstructured' , nvertex=6) 
    108    CALL xios_set_domain_attr("i",lonvalue=lon, latvalue=lat, bounds_lon=bounds_lon, bounds_lat=bounds_lat) 
     112   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell) 
     113   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6) 
     114   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat) 
    109115    
    110116   DEALLOCATE(lon, lat, bounds_lon, bounds_lat)  
    … …  
    183189 
    184190   
    185    CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ+1, ni=ncell) 
     191   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell) 
    186192   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3) 
    187    CALL xios_set_domain_attr("v",lonvalue=lon, latvalue=lat, bounds_lon=bounds_lon, bounds_lat=bounds_lat) 
     193   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat) 
    188194 
    189195 
    … …  
    239245       
    240246 END SUBROUTINE xios_write_field 
     247 
     248 SUBROUTINE xios_read_field(name,field) 
     249 USE field_mod 
     250 IMPLICIT NONE  
     251   CHARACTER(LEN=*),INTENT(IN) :: name 
     252   TYPE(t_field), POINTER :: field(:) 
     253   CHARACTER(LEN=10) :: str_number 
     254   INTEGER :: iq 
     255 
     256!$OMP BARRIER 
     257!$OMP MASTER 
     258    
     259   IF (Field(1)%field_type==field_T) THEN 
     260     IF (field(1)%ndim==2) THEN 
     261        CALL xios_read_field_scalar(name,field,1) 
     262      ELSE IF (field(1)%ndim==3) THEN 
     263        CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2)) 
     264      ELSE IF (field(1)%ndim==4) THEN 
     265        DO iq=1,size(field(1)%rval4d,3) 
     266          WRITE(str_number,'(i10)') iq 
     267          CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
     268        ENDDO 
     269      ELSE 
     270        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
     271      ENDIF 
     272    ELSE IF (Field(1)%field_type==field_Z) THEN 
     273     IF (field(1)%ndim==2) THEN 
     274        CALL xios_read_field_vort(name,field,1) 
     275      ELSE IF (field(1)%ndim==3) THEN 
     276        CALL xios_read_field_vort(name,field,size(field(1)%rval3d,2)) 
     277      ELSE IF (field(1)%ndim==4) THEN 
     278        DO iq=1,size(field(1)%rval4d,3) 
     279          WRITE(str_number,'(i10)') iq 
     280          CALL xios_read_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
     281        ENDDO 
     282      ELSE 
     283        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
     284      ENDIF 
     285    ENDIF 
     286!$OMP END MASTER 
     287!$OMP BARRIER 
     288       
     289 END SUBROUTINE xios_read_field 
     290 
     291 
    241292  
    242293 SUBROUTINE xios_write_field_scalar(name,field,nlev,iq) 
    … …  
    309360    
    310361   CALL xios_send_field(name,field_tmp) 
    311  
     362  
    312363 END SUBROUTINE xios_write_field_scalar   
     364 
     365 
     366 SUBROUTINE xios_read_field_scalar(name,field,nlev,iq) 
     367 USE genmod 
     368 USE mpipara 
     369 USE xios 
     370 USE grid_param 
     371 USE domain_mod 
     372 USE dimensions 
     373 USE spherical_geom_mod 
     374 USE geometry 
     375 USE mpi_mod 
     376 IMPLICIT NONE  
     377   CHARACTER(LEN=*),INTENT(IN) :: name 
     378   TYPE(t_field), POINTER :: field(:) 
     379   INTEGER,INTENT(IN) :: nlev 
     380   INTEGER,INTENT(IN),OPTIONAL :: iq 
     381    
     382   REAL(rstd) :: field_tmp(ncell_i,nlev) 
     383   TYPE(t_domain),POINTER :: d 
     384   INTEGER :: n,i,j,ij,ind 
     385 
     386   CALL xios_recv_field(name,field_tmp) 
     387    
     388   IF (field(1)%ndim==2) THEN 
     389     n=0 
     390     DO ind=1,ndomain 
     391        
     392       d=>domain(ind) 
     393         
     394       DO j=d%jj_begin,d%jj_end 
     395         DO i=d%ii_begin,d%ii_end 
     396           IF (d%own(i,j)) THEN 
     397             n=n+1 
     398             ij=d%iim*(j-1)+i 
     399             field(ind)%rval2d(ij)=field_tmp(n,1) 
     400           ENDIF 
     401         ENDDO 
     402       ENDDO 
     403     ENDDO 
     404   ELSE IF (field(1)%ndim==3) THEN 
     405     n=0 
     406     DO ind=1,ndomain 
     407       d=>domain(ind) 
     408         
     409       DO j=d%jj_begin,d%jj_end 
     410         DO i=d%ii_begin,d%ii_end 
     411           IF (d%own(i,j)) THEN 
     412             n=n+1 
     413             ij=d%iim*(j-1)+i 
     414             field(ind)%rval3d(ij,:)=field_tmp(n,:) 
     415           ENDIF 
     416         ENDDO 
     417       ENDDO 
     418     ENDDO 
     419   ELSE IF (field(1)%ndim==4) THEN 
     420     n=0 
     421     DO ind=1,ndomain 
     422       d=>domain(ind) 
     423         
     424       DO j=d%jj_begin,d%jj_end 
     425         DO i=d%ii_begin,d%ii_end 
     426           IF (d%own(i,j)) THEN 
     427             n=n+1 
     428             ij=d%iim*(j-1)+i 
     429             field(ind)%rval4d(ij,:,iq)=field_tmp(n,:) 
     430           ENDIF 
     431         ENDDO 
     432       ENDDO 
     433     ENDDO      
     434   ENDIF 
     435  
     436 END SUBROUTINE xios_read_field_scalar 
     437 
     438 
    313439       
    314440 SUBROUTINE xios_write_field_vort(name,field,nlev,iq) 
    … …  
    409535  
    410536 END SUBROUTINE xios_write_field_vort  
     537 
     538 SUBROUTINE xios_read_field_vort(name,field,nlev,iq) 
     539 USE genmod 
     540 USE mpipara 
     541 USE xios 
     542 USE grid_param 
     543 USE domain_mod 
     544 USE dimensions 
     545 USE spherical_geom_mod 
     546 USE geometry 
     547 USE mpi_mod 
     548 IMPLICIT NONE  
     549   CHARACTER(LEN=*),INTENT(IN) :: name 
     550   TYPE(t_field), POINTER :: field(:) 
     551   INTEGER,INTENT(IN) :: nlev 
     552   INTEGER,INTENT(IN),OPTIONAL :: iq 
     553    
     554   REAL(rstd) :: field_tmp(ncell_v,nlev) 
     555   TYPE(t_domain),POINTER :: d 
     556   INTEGER :: n,i,j,ij,ind 
     557 
     558   CALL xios_recv_field(name,field_tmp) 
     559 
     560    
     561   IF (field(1)%ndim==2) THEN 
     562     n=0 
     563     DO ind=1,ndomain 
     564       d=>domain(ind) 
     565       CALL swap_dimensions(ind)   
     566        
     567       DO j=d%jj_begin+1,d%jj_end 
     568         DO i=d%ii_begin,d%ii_end-1 
     569           n=n+1 
     570           ij=iim*(j-1)+i 
     571           field(ind)%rval2d(ij+z_down)=Field_tmp(n,1) 
     572         ENDDO 
     573       ENDDO 
     574 
     575       DO j=d%jj_begin,d%jj_end-1 
     576         DO i=d%ii_begin+1,d%ii_end 
     577           n=n+1 
     578           ij=iim*(j-1)+i 
     579           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up) 
     580           field(ind)%rval2d(ij+z_up)=Field_tmp(n,1) 
     581          ENDDO 
     582       ENDDO 
     583           
     584     ENDDO 
     585 
     586   ELSE IF (field(1)%ndim==3) THEN 
     587     n=0 
     588     DO ind=1,ndomain 
     589       d=>domain(ind) 
     590       CALL swap_dimensions(ind)     
     591              
     592       DO j=d%jj_begin+1,d%jj_end 
     593         DO i=d%ii_begin,d%ii_end-1 
     594           n=n+1 
     595           ij=iim*(j-1)+i 
     596           field(ind)%rval3d(ij+z_down,:)=Field_tmp(n,:) 
     597         ENDDO 
     598       ENDDO 
     599 
     600       DO j=d%jj_begin,d%jj_end-1 
     601         DO i=d%ii_begin+1,d%ii_end 
     602           n=n+1 
     603           ij=iim*(j-1)+i 
     604           field(ind)%rval3d(ij+z_up,:)=Field_tmp(n,:) 
     605          ENDDO 
     606       ENDDO 
     607           
     608     ENDDO 
     609 
     610   ELSE IF (field(1)%ndim==4) THEN 
     611     n=0 
     612     DO ind=1,ndomain 
     613       d=>domain(ind) 
     614       CALL swap_dimensions(ind)  
     615                
     616       DO j=d%jj_begin+1,d%jj_end 
     617         DO i=d%ii_begin,d%ii_end-1 
     618           n=n+1 
     619           ij=iim*(j-1)+i 
     620           field(ind)%rval4d(ij+z_down,:,iq)=Field_tmp(n,:) 
     621         ENDDO 
     622       ENDDO 
     623 
     624       DO j=d%jj_begin,d%jj_end-1 
     625         DO i=d%ii_begin+1,d%ii_end 
     626           n=n+1 
     627           ij=iim*(j-1)+i 
     628           field(ind)%rval4d(ij+z_up,:,iq)=Field_tmp(n,:) 
     629          ENDDO 
     630       ENDDO 
     631           
     632     ENDDO 
     633 
     634   ENDIF 
     635  
     636 END SUBROUTINE xios_read_field_vort  
     637 
     638 
     639 
     640 
    411641   
    412642 SUBROUTINE xios_write_field_finalize 
Note: See TracChangeset for help on using the changeset viewer.