Changeset 266 for codes


Ignore:
Timestamp:
08/05/14 15:56:49 (10 years ago)
Author:
ymipsl
Message:

Synchronize trunk and Saturn branch.
Merge modification from Saturn branch to trunk

YM

Location:
codes/icosagcm/trunk/src
Files:
3 added
18 edited

Legend:

Unmodified
Added
Removed

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

    r202 r266  
    300300!            f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p) 
    301301       CALL un2ulonlat(f_u, f_buf_ulon, f_buf_ulat) 
    302        CALL writefield("ulon",f_buf_ulon) 
    303        CALL writefield("ulat",f_buf_ulat) 
     302       CALL output_field("ulon",f_buf_ulon) 
     303       CALL output_field("ulat",f_buf_ulat) 
    304304 
    305305       CALL output_field("ps",f_ps) 

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

    r198 r266  
    7171    IF (is_mpi_root) THEN  
    7272!$OMP MASTER        
    73        IF ( it == 0  ) Then  
     73       IF ( it == itau0  ) Then  
    7474          ztot0 = ztot 
    7575          mtot0 = mtot 

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

    r210 r266  
    5757      ENDIF 
    5858    ENDDO 
     59     
     60    CLOSE(unit) 
    5961!$OMP END MASTER 
    6062    IF (omp_in_parallel()) THEN 
    … …  
    7476      WRITE(*,*) "bp()=",bp 
    7577      WRITE(*,*) "Approximative mid-layer pressure, assuming a surface pressure preff=",preff," Pa" 
    76       WRITE(*,*) "and approximative mid-layer height, assuming an atmospheric scale height of ",scaleheight/1000," (km)" 
     78      WRITE(*,*) "and approximative mid-layer height, assuming an atmospheric scale height of ",scale_height/1000," (km)" 
    7779      DO l=1,llm 
    78         WRITE(*,*) 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*scaleheight/1000,       & 
    79                    ' DZ ~ ',scaleheight/1000*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
     80        WRITE(*,*) 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*scale_height/1000,       & 
     81                   ' DZ ~ ',scale_height/1000*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
    8082      ENDDO 
    8183!$OMP END MASTER 

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

    r208 r266  
    7070      WRITE(*,*) "bp()=",bp 
    7171      WRITE(*,*) "Approximative mid-layer pressure, assuming a surface pressure preff=",preff," Pa" 
    72       WRITE(*,*) "and approximative mid-layer height, assuming an atmospheric scale height of ",scaleheight/1000," (km)" 
     72      WRITE(*,*) "and approximative mid-layer height, assuming an atmospheric scale height of ",scale_height/1000," (km)" 
    7373      DO l=1,llm 
    74         WRITE(*,*) 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*scaleheight/1000,       & 
    75                    ' DZ ~ ',scaleheight/1000*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
     74        WRITE(*,*) 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*scale_height/1000,       & 
     75                   ' DZ ~ ',scale_height/1000*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
    7676      ENDDO 
    7777!$OMP END MASTER 

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

    r186 r266  
    1717    INTEGER :: jj_end_glo 
    1818    INTEGER,POINTER  :: assign_domain(:,:) 
     19    INTEGER,POINTER  :: assign_cell_glo(:,:) 
    1920    INTEGER,POINTER  :: assign_i(:,:) 
    2021    INTEGER,POINTER  :: assign_j(:,:) 
    … …  
    142143          d%face=nf         
    143144          ALLOCATE(d%assign_domain(d%iim,d%jjm)) 
     145          ALLOCATE(d%assign_cell_glo(d%iim,d%jjm)) 
    144146          ALLOCATE(d%assign_i(d%iim,d%jjm)) 
    145147          ALLOCATE(d%assign_j(d%iim,d%jjm)) 
    … …  
    183185    d2%jj_end_glo = d1%jj_end_glo 
    184186    d2%assign_domain => d1%assign_domain 
     187    d2%assign_cell_glo => d1%assign_cell_glo 
    185188    d2%assign_i => d1%assign_i 
    186189    d2%assign_j => d1%assign_j 
    … …  
    268271          jj=d%jj_begin_glo-d%jj_begin+j 
    269272          ind=vertex_glo(ii,jj,nf)%ind 
     273          d%assign_cell_glo(i,j) = ind   
    270274          d%assign_domain(i,j)=cell_glo(ind)%assign_domain 
    271275          d%assign_i(i,j)=cell_glo(ind)%assign_i 

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

    r208 r266  
    1111  REAL(rstd),SAVE :: preff=101325. 
    1212  REAL(rstd),SAVE :: pa=50000. 
    13   REAL(rstd),SAVE :: scaleheight=8000. ! atmospheric scale height (m) 
     13  REAL(rstd),SAVE :: scale_height=8000. ! atmospheric scale height (m) 
    1414  REAL(rstd),SAVE :: scale_factor=1. 
     15  REAL(rstd),SAVE :: gas_constant = 8.3144621  
     16  REAL(rstd),SAVE :: mu                 ! molar mass of the atmosphere 
    1517 
    1618  LOGICAL, SAVE :: boussinesq 
    … …  
    3032    CALL getin("cpp",cpp)   
    3133    CALL getin("preff",preff)   
    32     CALL getin("scaleheight",scaleheight) 
     34    CALL getin("scale_height",scale_height) 
    3335     
     36    mu=kappa/cpp 
    3437    boussinesq=.FALSE. 
    3538    CALL getin("boussinesq",boussinesq)   

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

    r204 r266  
    2727    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0  
    2828    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0  
     29    USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0   
    2930 
    3031    IMPLICIT NONE 
    … …  
    6667       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q) 
    6768       !------------------- Old interface -------------------- 
     69    CASE ('start_file') 
     70       CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    6871    CASE ('academic') 
    6972       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 

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

    r186 r266  
    116116  END SUBROUTINE allocate_field 
    117117 
    118   SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2) 
     118  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name) 
    119119  USE domain_mod 
    120120  IMPLICIT NONE 
    … …  
    123123    INTEGER,INTENT(IN) :: data_type 
    124124    INTEGER,OPTIONAL :: dim1,dim2 
     125    CHARACTER(*), OPTIONAL :: name 
    125126    INTEGER :: ind 
    126127    INTEGER :: ii_size,jj_size 
    … …  
    141142      ENDIF 
    142143     
     144      IF(PRESENT(name)) THEN 
     145         field(ind)%name = name 
     146      ELSE 
     147         field(ind)%name = '(undefined)' 
     148      END IF 
    143149     
    144150      field(ind)%data_type=data_type 
    … …  
    180186    INTEGER :: ind 
    181187 
     188!$OMP BARRIER 
    182189    DO ind=1,ndomain 
     190      IF (.NOT. assigned_domain(ind)) CYCLE 
    183191 
    184192      data_type=field(ind)%data_type 
    … …  
    199207       
    200208   ENDDO 
     209!$OMP BARRIER 
     210!$OMP MASTER 
    201211   DEALLOCATE(field) 
     212!$OMP END MASTER 
     213!$OMP BARRIER 
    202214        
    203215  END SUBROUTINE deallocate_field 

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

    r186 r266  
    8383  IMPLICIT NONE 
    8484   
    85     CALL allocate_field(geom%Ai,field_t,type_real) 
     85    CALL allocate_field(geom%Ai,field_t,type_real,name='Ai') 
    8686    CALL allocate_field(geom%xyz_i,field_t,type_real,3) 
    8787    CALL allocate_field(geom%centroid,field_t,type_real,3) 

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

    r189 r266  
    77  INTEGER :: MPI_REAL8 
    88  INTEGER :: MPI_INTEGER 
     9  INTEGER :: MPI_CHARACTER 
     10  INTEGER :: MPI_LOGICAL 
    911  INTEGER :: MPI_ANY_SOURCE 
    1012  INTEGER :: MPI_MAX 

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

    r216 r266  
    99  LOGICAL,SAVE :: using_mpi 
    1010  LOGICAL,SAVE :: is_mpi_root 
     11  LOGICAL,SAVE :: is_mpi_master 
     12  LOGICAL,SAVE :: mpi_master 
     13   
    1114   
    1215  INTERFACE allocate_mpi_buffer 
    … …  
    108111    ENDIF 
    109112     
     113    mpi_master=0 
    110114    IF (mpi_rank==0) THEN  
    111115      is_mpi_root=.TRUE. 
     116      is_mpi_master=.TRUE. 
    112117    ELSE 
    113118      is_mpi_root=.FALSE. 
     119      is_mpi_master=.FALSE. 
    114120    ENDIF 
    115121     
    … …  
    118124  SUBROUTINE finalize_mpipara 
    119125  USE mpi_mod 
    120   IMPLICIT NONE 
    121      
     126#ifdef CPP_USING_XIOS 
     127  USE xios 
     128#endif 
     129  IMPLICIT NONE 
     130     
     131#ifdef CPP_USING_XIOS 
     132      CALL xios_finalize 
     133#endif 
    122134    IF (using_mpi) CALL MPI_FINALIZE(ierr) 
    123135     

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

    r217 r266  
    5151  END SUBROUTINE init_physics 
    5252 
    53   SUBROUTINE physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
     53  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    5454    USE icosa 
    5555    USE physics_interface_mod 
    … …  
    5858    IMPLICIT NONE 
    5959    INTEGER, INTENT(IN)   :: it 
    60     REAL(rstd),INTENT(IN)::jD_cur,jH_cur 
    6160    TYPE(t_field),POINTER :: f_phis(:) 
    6261    TYPE(t_field),POINTER :: f_ps(:) 

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

    r212 r266  
    99  INTEGER,SAVE :: it 
    1010!$OMP THREADPRIVATE(it)   
     11 
     12  INTEGER,SAVE :: itau0=0 
     13!$OMP THREADPRIVATE(itau0)   
    1114 
    1215  REAL(rstd),SAVE :: dt 
    … …  
    3740         dt, write_period, itau_out, itau_adv, itau_dissip, itau_physics, itaumax, &  
    3841day_step,ndays,jD_ref,jH_ref,day_ini,day_end,annee_ref,day_ref,an, mois, jour,heure, & 
    39             calend,time_style 
     42            calend,time_style,itau0 
    4043 
    4144 

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

    r202 r266  
    2121!$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme) 
    2222 
    23   REAL(rstd),SAVE :: jD_cur, jH_cur 
    24 !$OMP THREADPRIVATE(jD_cur, jH_cur)   
    25   REAL(rstd),SAVE :: start_time 
    26 !$OMP THREADPRIVATE(start_time) 
    2723CONTAINS 
    2824   
    … …  
    4743    CHARACTER(len=255) :: def 
    4844 
    49 !---------------------------------------------------- 
    50 !  IF (TRIM(time_style)=='lmd')  Then 
    51  
    52 !   day_step=180 
    53 !   CALL getin('day_step',day_step) 
    54  
    55 !   ndays=1 
    56 !   CALL getin('ndays',ndays) 
    57  
    58 !   dt = daysec/REAL(day_step) 
    59 !   itaumax = ndays*day_step 
    60  
    61 !   calend = 'earth_360d' 
    62 !   CALL getin('calend', calend) 
    63  
    64 !   day_ini = 0 
    65 !   CALL getin('day_ini',day_ini) 
    66  
    67 !   day_end = 0 
    68 !   CALL getin('day_end',day_end) 
    69  
    70 !   annee_ref = 1998 
    71 !   CALL getin('annee_ref',annee_ref) 
    72  
    73 !   start_time = 0 
    74 !   CALL getin('start_time',start_time)  
    75  
    76 !    
    77 !   write_period=0 
    78 !   CALL getin('write_period',write_period) 
    79 !       
    80 !   write_period=write_period/scale_factor 
    81 !   itau_out=FLOOR(write_period/dt) 
    82 !    
    83 !   PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out  
    84  
    85 !  mois = 1 ; heure = 0. 
    86 !  call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref) 
    87 !  jH_ref = jD_ref - int(jD_ref)  
    88 !  jD_ref = int(jD_ref)  
    89 !   
    90 !  CALL ioconf_startdate(INT(jD_ref),jH_ref)  
    91 !  write(*,*)'annee_ref, mois, day_ref, heure, jD_ref' 
    92 !  write(*,*)annee_ref, mois, day_ref, heure, jD_ref 
    93 !  write(*,*)"ndays,day_step,itaumax,dt======>" 
    94 !  write(*,*)ndays,day_step,itaumax,dt 
    95 !  call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure) 
    96 !  write(*,*)'jD_ref+jH_ref,an, mois, jour, heure' 
    97 !  write(*,*)jD_ref+jH_ref,an, mois, jour, heure 
    98 !  day_end = day_ini + ndays  
    99 ! END IF  
    100 !---------------------------------------------------- 
    10145 
    10246   IF (xios_output) itau_out=1 
    … …  
    11761    CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,name='theta_rhodzm1') 
    11862! Tracers 
    119     CALL allocate_field(f_q,field_t,type_real,llm,nqtot) 
     63    CALL allocate_field(f_q,field_t,type_real,llm,nqtot,'q') 
    12064    CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz') 
    12165! Mass fluxes 
    … …  
    212156  USE xios_mod 
    213157  USE output_field_mod 
     158  USE write_etat0_mod 
    214159  IMPLICIT NONE   
    215160    REAL(rstd),POINTER :: q(:,:,:) 
    … …  
    227172    INTEGER :: stop_clock 
    228173    INTEGER :: rate_clock 
     174     
     175     
     176!    CALL write_etat0(f_ps, f_phis,f_theta_rhodz,f_u,f_q)  
     177!    CALL read_start(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q)  
     178!    CALL write_restart(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q)  
    229179     
    230180    CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces 
    … …  
    248198!$OMP END MASTER    
    249199 
     200  CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,itau0)   
     201 
    250202  CALL trace_on 
    251203   
    252   DO it=0,itaumax 
     204  DO it=itau0+1,itau0+itaumax 
    253205     
    254206    IF (xios_output) CALL xios_update_calendar(it) 
    255     IF (MOD(it,itau_sync)==0) THEN 
     207    IF (it==itau0+1 .OR. MOD(it,itau_sync)==0) THEN 
    256208      CALL send_message(f_ps,req_ps0) 
    257209      CALL wait_message(req_ps0) 
    … …  
    299251    END DO 
    300252 
    301     IF (MOD(it+1,itau_dissip)==0) THEN 
     253    IF (MOD(it,itau_dissip)==0) THEN 
    302254!         CALL send_message(f_ps,req_ps) 
    303255!         CALL wait_message(req_ps)   
    … …  
    320272    END IF 
    321273 
    322     IF(MOD(it+1,itau_adv)==0) THEN 
     274    IF(MOD(it,itau_adv)==0) THEN 
    323275 
    324276       CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step 
    … …  
    339291 
    340292 
    341  
    342 !---------------------------------------------------- 
    343 !    jD_cur = jD_ref + day_ini - day_ref + it/day_step 
    344 !    jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step) 
    345 !    jD_cur = jD_cur + int(jH_cur) 
    346 !    jH_cur = jH_cur - int(jH_cur) 
    347     CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 
    348  
    349     ENDDO 
    350  
    351     CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)   
     293    IF (MOD(it,itau_physics)==0) THEN 
     294      CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u,  f_q) 
     295    ENDIF 
     296     
     297  ENDDO 
     298 
     299  CALL write_etat0(itau0+itaumax,f_ps, f_phis,f_theta_rhodz,f_u,f_q)  
     300 
     301  CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)   
    352302 
    353303!$OMP MASTER 
    354     CALL SYSTEM_CLOCK(stop_clock) 
    355     CALL SYSTEM_CLOCK(count_rate=rate_clock) 
    356      
    357     IF (mpi_rank==0) THEN  
    358       PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 
    359     ENDIF   
     304  CALL SYSTEM_CLOCK(stop_clock) 
     305  CALL SYSTEM_CLOCK(count_rate=rate_clock) 
     306     
     307  IF (mpi_rank==0) THEN  
     308    PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock  
     309  ENDIF   
    360310!$OMP END MASTER  
    361311  
    362   CONTAINS 
     312 CONTAINS 
    363313 
    364314    SUBROUTINE Euler_scheme(with_dps) 

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

    r151 r266  
    33#ifdef CPP_USING_MPI 
    44  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, & 
    5                                 req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, & 
     5                                req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, scatter_field, & 
    66                                t_message,init_message=>init_message_mpi,transfert_message=>transfert_message_mpi,  & 
    7                                 send_message=>send_message_mpi,test_message=>test_message_mpi,wait_message=>wait_message_mpi,barrier 
     7                                send_message=>send_message_mpi,test_message=>test_message_mpi,wait_message=>wait_message_mpi,barrier, & 
     8                                bcast_mpi 
    89#else  
    910  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, & 
    10                                 req_e1_scal,req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, & 
     11                                req_e1_scal,req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, scatter_field,& 
    1112                                t_message,init_message=>init_message_seq,transfert_message=>transfert_message_seq,  & 
    12                                 send_message=>send_message_seq,test_message=>test_message_seq,wait_message=>wait_message_seq,barrier 
     13                                send_message=>send_message_seq,test_message=>test_message_seq,wait_message=>wait_message_seq,barrier, & 
     14                                bcast_mpi 
    1315#endif 
     16 
     17  USE transfert_omp_mod 
     18   
     19  INTERFACE bcast 
     20    MODULE PROCEDURE bcast_c,                                     & 
     21                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, & 
     22                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, & 
     23                     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4 
     24 
     25  END INTERFACE 
     26 
     27 
     28CONTAINS 
     29 
     30 
     31!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     32!! Definition des Broadcast --> 4D   !! 
     33!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     34 
     35!! -- Les chaine de charactère -- !! 
     36 
     37  SUBROUTINE bcast_c(var) 
     38  IMPLICIT NONE 
     39    CHARACTER(LEN=*),INTENT(INOUT) :: Var 
     40    
     41!$OMP MASTER 
     42    CALL bcast_mpi(Var) 
     43!$OMP END MASTER 
     44    CALL bcast_omp(Var) 
     45     
     46  END SUBROUTINE bcast_c 
     47 
     48!! -- Les entiers -- !! 
     49   
     50  SUBROUTINE bcast_i(var) 
     51  IMPLICIT NONE 
     52    INTEGER,INTENT(INOUT) :: Var 
     53!$OMP MASTER 
     54    CALL bcast_mpi(Var) 
     55!$OMP END MASTER 
     56    CALL bcast_omp(Var) 
     57     
     58  END SUBROUTINE bcast_i 
     59 
     60  SUBROUTINE bcast_i1(var) 
     61  IMPLICIT NONE 
     62    INTEGER,INTENT(INOUT) :: Var(:) 
     63    
     64!$OMP MASTER 
     65    CALL bcast_mpi(Var) 
     66!$OMP END MASTER 
     67    CALL bcast_omp(Var) 
     68     
     69  END SUBROUTINE bcast_i1 
     70 
     71 
     72  SUBROUTINE bcast_i2(var) 
     73  IMPLICIT NONE 
     74    INTEGER,INTENT(INOUT) :: Var(:,:) 
     75    
     76!$OMP MASTER 
     77    CALL bcast_mpi(Var) 
     78!$OMP END MASTER 
     79    CALL bcast_omp(Var) 
     80     
     81  END SUBROUTINE bcast_i2 
     82 
     83 
     84  SUBROUTINE bcast_i3(var) 
     85  IMPLICIT NONE 
     86    INTEGER,INTENT(INOUT) :: Var(:,:,:) 
     87    
     88!$OMP MASTER 
     89    CALL bcast_mpi(Var) 
     90!$OMP END MASTER 
     91    CALL bcast_omp(Var) 
     92     
     93  END SUBROUTINE bcast_i3 
     94 
     95 
     96  SUBROUTINE bcast_i4(var) 
     97  IMPLICIT NONE 
     98    INTEGER,INTENT(INOUT) :: Var(:,:,:,:) 
     99    
     100!$OMP MASTER 
     101    CALL bcast_mpi(Var) 
     102!$OMP END MASTER 
     103    CALL bcast_omp(Var) 
     104     
     105  END SUBROUTINE bcast_i4 
     106 
     107  
     108!! -- Les reels -- !! 
     109   
     110  SUBROUTINE bcast_r(var) 
     111  IMPLICIT NONE 
     112    REAL,INTENT(INOUT) :: Var 
     113 
     114!$OMP MASTER 
     115    CALL bcast_mpi(Var) 
     116!$OMP END MASTER 
     117    CALL bcast_omp(Var) 
     118     
     119  END SUBROUTINE bcast_r 
     120 
     121  SUBROUTINE bcast_r1(var) 
     122  IMPLICIT NONE 
     123    REAL,INTENT(INOUT) :: Var(:) 
     124    
     125!$OMP MASTER 
     126    CALL bcast_mpi(Var) 
     127!$OMP END MASTER 
     128    CALL bcast_omp(Var) 
     129     
     130  END SUBROUTINE bcast_r1 
     131 
     132 
     133  SUBROUTINE bcast_r2(var) 
     134  IMPLICIT NONE 
     135    REAL,INTENT(INOUT) :: Var(:,:) 
     136    
     137!$OMP MASTER 
     138    CALL bcast_mpi(Var) 
     139!$OMP END MASTER 
     140    CALL bcast_omp(Var) 
     141     
     142  END SUBROUTINE bcast_r2 
     143 
     144 
     145  SUBROUTINE bcast_r3(var) 
     146  IMPLICIT NONE 
     147    REAL,INTENT(INOUT) :: Var(:,:,:) 
     148    
     149!$OMP MASTER 
     150    CALL bcast_mpi(Var) 
     151!$OMP END MASTER 
     152    CALL bcast_omp(Var) 
     153     
     154  END SUBROUTINE bcast_r3 
     155 
     156 
     157  SUBROUTINE bcast_r4(var) 
     158  IMPLICIT NONE 
     159    REAL,INTENT(INOUT) :: Var(:,:,:,:) 
     160    
     161!$OMP MASTER 
     162    CALL bcast_mpi(Var) 
     163!$OMP END MASTER 
     164    CALL bcast_omp(Var) 
     165     
     166  END SUBROUTINE bcast_r4  
     167 
     168 
     169!! -- Les booleens -- !! 
     170   
     171  SUBROUTINE bcast_l(var) 
     172  IMPLICIT NONE 
     173    LOGICAL,INTENT(INOUT) :: Var 
     174!$OMP MASTER 
     175    CALL bcast_mpi(Var) 
     176!$OMP END MASTER 
     177    CALL bcast_omp(Var) 
     178     
     179  END SUBROUTINE bcast_l 
     180 
     181  SUBROUTINE bcast_l1(var) 
     182  IMPLICIT NONE 
     183    LOGICAL,INTENT(INOUT) :: Var(:) 
     184    
     185!$OMP MASTER 
     186    CALL bcast_mpi(Var) 
     187!$OMP END MASTER 
     188    CALL bcast_omp(Var) 
     189     
     190  END SUBROUTINE bcast_l1 
     191 
     192 
     193  SUBROUTINE bcast_l2(var) 
     194  IMPLICIT NONE 
     195    LOGICAL,INTENT(INOUT) :: Var(:,:) 
     196    
     197!$OMP MASTER 
     198    CALL bcast_mpi(Var) 
     199!$OMP END MASTER 
     200    CALL bcast_omp(Var) 
     201     
     202  END SUBROUTINE bcast_l2 
     203 
     204 
     205  SUBROUTINE bcast_l3(var) 
     206  IMPLICIT NONE 
     207    LOGICAL,INTENT(INOUT) :: Var(:,:,:) 
     208    
     209!$OMP MASTER 
     210    CALL bcast_mpi(Var) 
     211!$OMP END MASTER 
     212    CALL bcast_omp(Var) 
     213     
     214  END SUBROUTINE bcast_l3 
     215 
     216 
     217  SUBROUTINE bcast_l4(var) 
     218  IMPLICIT NONE 
     219    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) 
     220    
     221!$OMP MASTER 
     222    CALL bcast_mpi(Var) 
     223!$OMP END MASTER 
     224    CALL bcast_omp(Var) 
     225     
     226  END SUBROUTINE bcast_l4 
     227 
    14228   
    15229END MODULE transfert_mod 

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

    r193 r266  
    7474    INTEGER :: number 
    7575  END TYPE t_message 
     76 
     77 
     78  INTERFACE bcast_mpi 
     79    MODULE PROCEDURE bcast_mpi_c,                                                     & 
     80                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, & 
     81                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, & 
     82                     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4 
     83  END INTERFACE 
     84 
     85 
    7686   
    7787CONTAINS 
    … …  
    16461656  END SUBROUTINE gather_field 
    16471657 
     1658 
     1659  SUBROUTINE scatter_field(field_glo,field_loc) 
     1660  USE field_mod 
     1661  USE domain_mod 
     1662  USE mpi_mod 
     1663  USE mpipara 
     1664  IMPLICIT NONE 
     1665    TYPE(t_field),POINTER :: field_glo(:) 
     1666    TYPE(t_field),POINTER :: field_loc(:) 
     1667    INTEGER, ALLOCATABLE :: mpi_req(:) 
     1668    INTEGER, ALLOCATABLE :: status(:,:) 
     1669    INTEGER :: ireq,nreq 
     1670    INTEGER :: ind_glo,ind_loc     
     1671   
     1672    IF (.NOT. using_mpi) THEN 
     1673     
     1674      DO ind_loc=1,ndomain 
     1675        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d 
     1676        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d 
     1677        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 
     1678      ENDDO 
     1679     
     1680    ELSE 
     1681           
     1682      nreq=ndomain 
     1683      IF (mpi_rank==0) nreq=nreq+ndomain_glo  
     1684      ALLOCATE(mpi_req(nreq)) 
     1685      ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
     1686     
     1687     
     1688      ireq=0 
     1689      IF (mpi_rank==0) THEN 
     1690        DO ind_glo=1,ndomain_glo 
     1691          ireq=ireq+1 
     1692 
     1693          IF (field_glo(ind_glo)%ndim==2) THEN 
     1694            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
     1695                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1696    
     1697          ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
     1698            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
     1699                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1700 
     1701          ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
     1702            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
     1703                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1704          ENDIF 
     1705          
     1706        ENDDO 
     1707      ENDIF 
     1708   
     1709      DO ind_loc=1,ndomain 
     1710        ireq=ireq+1 
     1711 
     1712        IF (field_loc(ind_loc)%ndim==2) THEN 
     1713          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
     1714                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1715        ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1716          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
     1717                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1718        ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1719          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
     1720                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1721        ENDIF 
     1722       
     1723      ENDDO 
     1724    
     1725      CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     1726 
     1727    ENDIF 
     1728         
     1729  END SUBROUTINE scatter_field 
     1730 
     1731 
    16481732    
    16491733  SUBROUTINE trace_in 
    … …  
    16611745  END SUBROUTINE trace_out               
    16621746 
     1747 
     1748 
     1749 
     1750!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1751!! Definition des Broadcast --> 4D   !! 
     1752!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1753 
     1754!! -- Les chaine de charactère -- !! 
     1755 
     1756  SUBROUTINE bcast_mpi_c(var1) 
     1757  IMPLICIT NONE 
     1758    CHARACTER(LEN=*),INTENT(INOUT) :: Var1 
     1759    
     1760    CALL bcast_mpi_cgen(Var1,len(Var1)) 
     1761 
     1762  END SUBROUTINE bcast_mpi_c 
     1763 
     1764!! -- Les entiers -- !! 
     1765   
     1766  SUBROUTINE bcast_mpi_i(var) 
     1767  USE mpipara 
     1768  IMPLICIT NONE 
     1769    INTEGER,INTENT(INOUT) :: Var 
     1770     
     1771    INTEGER               :: var_tmp(1) 
     1772     
     1773    IF (is_mpi_master) var_tmp(1)=var 
     1774    CALL bcast_mpi_igen(Var_tmp,1) 
     1775    var=var_tmp(1) 
     1776     
     1777  END SUBROUTINE bcast_mpi_i 
     1778 
     1779  SUBROUTINE bcast_mpi_i1(var) 
     1780  IMPLICIT NONE 
     1781    INTEGER,INTENT(INOUT) :: Var(:) 
     1782 
     1783    CALL bcast_mpi_igen(Var,size(Var)) 
     1784     
     1785  END SUBROUTINE bcast_mpi_i1 
     1786 
     1787  SUBROUTINE bcast_mpi_i2(var) 
     1788  IMPLICIT NONE 
     1789    INTEGER,INTENT(INOUT) :: Var(:,:) 
     1790    
     1791    CALL bcast_mpi_igen(Var,size(Var)) 
     1792   
     1793  END SUBROUTINE bcast_mpi_i2 
     1794 
     1795  SUBROUTINE bcast_mpi_i3(var) 
     1796  IMPLICIT NONE 
     1797    INTEGER,INTENT(INOUT) :: Var(:,:,:) 
     1798    
     1799    CALL bcast_mpi_igen(Var,size(Var)) 
     1800 
     1801  END SUBROUTINE bcast_mpi_i3 
     1802 
     1803  SUBROUTINE bcast_mpi_i4(var) 
     1804  IMPLICIT NONE 
     1805    INTEGER,INTENT(INOUT) :: Var(:,:,:,:) 
     1806    
     1807    CALL bcast_mpi_igen(Var,size(Var)) 
     1808 
     1809  END SUBROUTINE bcast_mpi_i4 
     1810 
     1811 
     1812!! -- Les reels -- !! 
     1813 
     1814  SUBROUTINE bcast_mpi_r(var) 
     1815  USE mpipara 
     1816  IMPLICIT NONE 
     1817    REAL,INTENT(INOUT) :: Var 
     1818    REAL               :: var_tmp(1) 
     1819     
     1820    IF (is_mpi_master) var_tmp(1)=var 
     1821    CALL bcast_mpi_rgen(Var_tmp,1) 
     1822    var=var_tmp(1)    
     1823 
     1824  END SUBROUTINE bcast_mpi_r 
     1825 
     1826  SUBROUTINE bcast_mpi_r1(var) 
     1827  IMPLICIT NONE 
     1828    REAL,INTENT(INOUT) :: Var(:) 
     1829    
     1830    CALL bcast_mpi_rgen(Var,size(Var)) 
     1831 
     1832  END SUBROUTINE bcast_mpi_r1 
     1833 
     1834  SUBROUTINE bcast_mpi_r2(var) 
     1835  IMPLICIT NONE 
     1836    REAL,INTENT(INOUT) :: Var(:,:) 
     1837    
     1838    CALL bcast_mpi_rgen(Var,size(Var)) 
     1839 
     1840  END SUBROUTINE bcast_mpi_r2 
     1841 
     1842  SUBROUTINE bcast_mpi_r3(var) 
     1843  IMPLICIT NONE 
     1844    REAL,INTENT(INOUT) :: Var(:,:,:) 
     1845    
     1846    CALL bcast_mpi_rgen(Var,size(Var)) 
     1847 
     1848  END SUBROUTINE bcast_mpi_r3 
     1849 
     1850  SUBROUTINE bcast_mpi_r4(var) 
     1851  IMPLICIT NONE 
     1852    REAL,INTENT(INOUT) :: Var(:,:,:,:) 
     1853    
     1854    CALL bcast_mpi_rgen(Var,size(Var)) 
     1855 
     1856  END SUBROUTINE bcast_mpi_r4 
     1857   
     1858!! -- Les booleans -- !! 
     1859 
     1860  SUBROUTINE bcast_mpi_l(var) 
     1861  USE mpipara 
     1862  IMPLICIT NONE 
     1863    LOGICAL,INTENT(INOUT) :: Var 
     1864    LOGICAL               :: var_tmp(1) 
     1865     
     1866    IF (is_mpi_master) var_tmp(1)=var 
     1867    CALL bcast_mpi_lgen(Var_tmp,1) 
     1868    var=var_tmp(1)    
     1869 
     1870  END SUBROUTINE bcast_mpi_l 
     1871 
     1872  SUBROUTINE bcast_mpi_l1(var) 
     1873  IMPLICIT NONE 
     1874    LOGICAL,INTENT(INOUT) :: Var(:) 
     1875    
     1876    CALL bcast_mpi_lgen(Var,size(Var)) 
     1877 
     1878  END SUBROUTINE bcast_mpi_l1 
     1879 
     1880  SUBROUTINE bcast_mpi_l2(var) 
     1881  IMPLICIT NONE 
     1882    LOGICAL,INTENT(INOUT) :: Var(:,:) 
     1883    
     1884    CALL bcast_mpi_lgen(Var,size(Var)) 
     1885 
     1886  END SUBROUTINE bcast_mpi_l2 
     1887 
     1888  SUBROUTINE bcast_mpi_l3(var) 
     1889  IMPLICIT NONE 
     1890    LOGICAL,INTENT(INOUT) :: Var(:,:,:) 
     1891    
     1892    CALL bcast_mpi_lgen(Var,size(Var)) 
     1893 
     1894  END SUBROUTINE bcast_mpi_l3 
     1895 
     1896  SUBROUTINE bcast_mpi_l4(var) 
     1897  IMPLICIT NONE 
     1898    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) 
     1899    
     1900    CALL bcast_mpi_lgen(Var,size(Var)) 
     1901 
     1902  END SUBROUTINE bcast_mpi_l4 
     1903   
     1904!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1905!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES ! 
     1906!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1907 
     1908  SUBROUTINE bcast_mpi_cgen(var,nb) 
     1909    USE mpi_mod 
     1910    USE mpipara 
     1911    IMPLICIT NONE 
     1912     
     1913    CHARACTER(LEN=*),INTENT(INOUT) :: Var 
     1914    INTEGER,INTENT(IN) :: nb 
     1915 
     1916    IF (.NOT. using_mpi) RETURN 
     1917     
     1918    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr) 
     1919         
     1920  END SUBROUTINE bcast_mpi_cgen 
     1921 
     1922 
     1923       
     1924  SUBROUTINE bcast_mpi_igen(var,nb) 
     1925    USE mpi_mod 
     1926    USE mpipara 
     1927    IMPLICIT NONE 
     1928     
     1929    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var 
     1930    INTEGER,INTENT(IN) :: nb 
     1931 
     1932    IF (.NOT. using_mpi) RETURN 
     1933 
     1934    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr) 
     1935         
     1936  END SUBROUTINE bcast_mpi_igen 
     1937 
     1938 
     1939 
     1940   
     1941  SUBROUTINE bcast_mpi_rgen(var,nb) 
     1942    USE mpi_mod 
     1943    USE mpipara 
     1944    IMPLICIT NONE 
     1945     
     1946    REAL,DIMENSION(nb),INTENT(INOUT) :: Var 
     1947    INTEGER,INTENT(IN) :: nb 
     1948 
     1949    IF (.NOT. using_mpi) RETURN 
     1950 
     1951    CALL MPI_BCAST(Var,nb,MPI_REAL,mpi_master,comm_icosa,ierr) 
     1952     
     1953  END SUBROUTINE bcast_mpi_rgen 
     1954   
     1955 
     1956 
     1957 
     1958  SUBROUTINE bcast_mpi_lgen(var,nb) 
     1959    USE mpi_mod 
     1960    USE mpipara 
     1961    IMPLICIT NONE 
     1962     
     1963    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var 
     1964    INTEGER,INTENT(IN) :: nb 
     1965 
     1966    IF (.NOT. using_mpi) RETURN 
     1967 
     1968    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr) 
     1969 
     1970  END SUBROUTINE bcast_mpi_lgen 
     1971   
     1972    
    16631973END MODULE transfert_mpi_mod 
    16641974       

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

    r196 r266  
    2424  END SUBROUTINE un2ulonlat 
    2525 
     26  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u) 
     27  USE icosa 
     28  IMPLICIT NONE 
     29    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons 
     30    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges 
     31     
     32    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:) 
     33    INTEGER :: ind 
     34 
     35    DO ind=1,ndomain 
     36       IF (.NOT. assigned_domain(ind)) CYCLE 
     37       CALL swap_dimensions(ind) 
     38       CALL swap_geometry(ind) 
     39       u=f_u(ind) 
     40       ulon=f_ulon(ind) 
     41       ulat=f_ulat(ind) 
     42       CALL compute_ulonlat2un(ulon, ulat,u) 
     43    END DO 
     44 
     45  END SUBROUTINE ulonlat2un 
    2646  
    2747  SUBROUTINE compute_wind_centered(ue,ucenter) 
    … …  
    298318 END SUBROUTINE compute_wind_centered_lonlat_compound 
    299319 
     320 SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc) 
     321  USE icosa   
     322     
     323  IMPLICIT NONE 
     324  REAL(rstd) :: ulon(iim*jjm,llm) 
     325  REAL(rstd) :: ulat(iim*jjm,llm) 
     326  REAL(rstd) :: uc(iim*jjm,3,llm) 
     327 
     328  INTEGER :: i,j,ij,l      
     329     
     330   
     331    DO l=1,llm 
     332      DO j=jj_begin,jj_end 
     333        DO i=ii_begin,ii_end 
     334          ij=(j-1)*iim+i 
     335          uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:) 
     336        ENDDO 
     337      ENDDO 
     338    ENDDO 
     339  
     340 END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered 
     341 
     342 
     343 
     344 SUBROUTINE compute_wind_perp_from_wind_centered(uc,un) 
     345  USE icosa   
     346     
     347  IMPLICIT NONE 
     348  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm) 
     349  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm) 
     350 
     351  INTEGER :: i,j,ij,l      
     352     
     353   
     354    DO l=1,llm 
     355      DO j=jj_begin,jj_end 
     356        DO i=ii_begin,ii_end 
     357          ij=(j-1)*iim+i 
     358          un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:)) 
     359          un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:)) 
     360          un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:)) 
     361         ENDDO 
     362      ENDDO 
     363    ENDDO 
     364  
     365 END SUBROUTINE compute_wind_perp_from_wind_centered 
     366 
     367 
    300368 SUBROUTINE compute_un2ulonlat(un, ulon, ulat) 
    301369  USE icosa   
    … …  
    313381 END SUBROUTINE compute_un2ulonlat 
    314382 
     383 SUBROUTINE compute_ulonlat2un(ulon, ulat,un) 
     384  USE icosa   
     385     
     386  IMPLICIT NONE 
     387  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm) 
     388  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm) 
     389  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm) 
     390 
     391  REAL(rstd)             :: uc(iim*jjm,3,llm) 
     392     
     393    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc)   
     394    CALL compute_wind_perp_from_wind_centered(uc, un) 
     395  
     396 END SUBROUTINE compute_ulonlat2un 
     397 
     398 
    315399END MODULE wind_mod 

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

    r186 r266  
    420420 
    421421 END SUBROUTINE xios_write_field_finalize 
    422     
     422 
     423 SUBROUTINE xios_set_context 
     424 IMPLICIT NONE    
     425  TYPE(xios_context) :: ctx_hdl 
     426 
     427!$OMP MASTER  
     428   CALL xios_get_handle("icosagcm",ctx_hdl) 
     429   CALL xios_set_current_context(ctx_hdl) 
     430!$OMP END MASTER 
     431 
     432  END SUBROUTINE xios_set_context 
    423433#else 
    424434   
    … …  
    447457  SUBROUTINE xios_init_write_field 
    448458  END SUBROUTINE xios_init_write_field   
     459   
     460  SUBROUTINE xios_set_context 
     461  END SUBROUTINE xios_set_context 
     462   
     463 
    449464#endif   
    450465   
Note: See TracChangeset for help on using the changeset viewer.