Changeset 131


Ignore:
Timestamp:
02/08/13 12:09:35 (11 years ago)
Author:
ymipsl
Message:

Some operations must be only done by the mpi master task.

YM

Location:
codes/icosagcm/trunk/src
Files:
14 edited

Legend:

Unmodified
Added
Removed

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

    r110 r131  
    3737    USE advect_mod 
    3838    USE disvert_mod 
     39    USE mpipara 
    3940    IMPLICIT NONE 
    4041    TYPE(t_field),POINTER :: f_ps(:) 
    … …  
    135136 
    136137    IF ( iadvtr == iapp_tracvl ) THEN  
    137        PRINT *, 'Advection scheme' 
     138       IF (is_mpi_root) PRINT *, 'Advection scheme' 
    138139       bigt = dt*iapp_tracvl 
    139140       DO ind=1,ndomain 

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

    r129 r131  
    1717    USE icosa 
    1818    USE exner_mod 
     19    USE mpipara 
    1920    IMPLICIT NONE 
    2021    CHARACTER(len=255) :: def 
    … …  
    2829       caldyn_conserv=2 
    2930    CASE DEFAULT 
    30        PRINT*,'Bad selector for variable caldyn_conserv : <', TRIM(def),'> options are <energy>, <enstrophy>' 
     31       IF (is_mpi_root) PRINT *,'Bad selector for variable caldyn_conserv : <', TRIM(def),'> options are <energy>, <enstrophy>' 
    3132       STOP 
    3233    END SELECT 
    33     PRINT *, 'caldyn_conserv=',def 
     34     IF (is_mpi_root) PRINT *, 'caldyn_conserv=',def 
    3435 
    3536    def='direct' 
    … …  
    4142       caldyn_exner=2 
    4243    CASE DEFAULT 
    43        PRINT*,'Bad selector for variable caldyn_exner : <', TRIM(def),'> options are <lmdz>, <direct>' 
     44       IF (is_mpi_root) PRINT*,'Bad selector for variable caldyn_exner : <', TRIM(def),'> options are <lmdz>, <direct>' 
    4445       STOP 
    4546    END SELECT 
    … …  
    5354       caldyn_hydrostat=2 
    5455    CASE DEFAULT 
    55        PRINT*,'Bad selector for variable caldyn_hydrostat : <', TRIM(def),'> options are <lmdz>, <direct>' 
     56       IF (is_mpi_root) PRINT*,'Bad selector for variable caldyn_hydrostat : <', TRIM(def),'> options are <lmdz>, <direct>' 
    5657       STOP 
    5758    END SELECT 
    … …  
    8586    USE kinetic_mod 
    8687    USE theta2theta_rhodz_mod 
     88    USE mpipara 
    8789    IMPLICIT NONE 
    8890    LOGICAL,INTENT(IN)    :: write_out 
    … …  
    169171 
    170172    IF (write_out) THEN 
    171        PRINT *,'CALL write_output_fields' 
     173       IF (is_mpi_root) PRINT *,'CALL write_output_fields' 
    172174       CALL write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, & 
    173175            f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p) 
    … …  
    645647  SUBROUTINE check_mass_conservation(f_ps,f_dps) 
    646648  USE icosa 
     649  USE mpipara 
    647650  IMPLICIT NONE 
    648651    TYPE(t_field),POINTER :: f_ps(:) 
    … …  
    677680    
    678681    ENDDO 
    679     PRINT*, "mass_tot ", mass_tot,"      dmass_tot ",dmass_tot         
     682    IF (is_mpi_root) PRINT*, "mass_tot ", mass_tot,"      dmass_tot ",dmass_tot         
    680683 
    681684  END SUBROUTINE check_mass_conservation   

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

    r129 r131  
    8484   CASE('none') 
    8585      rayleigh_friction_type=0 
    86       PRINT *, 'No Rayleigh friction' 
     86      IF (is_mpi_root) PRINT *, 'No Rayleigh friction' 
    8787   CASE('dcmip2_schaer_noshear') 
    8888      rayleigh_friction_type=1 
    8989      rayleigh_shear=0 
    90       PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1' 
     90      IF (is_mpi_root) PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1' 
    9191   CASE('dcmip2_schaer_shear') 
    9292      rayleigh_shear=1 
    9393      rayleigh_friction_type=2 
    94       PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2' 
     94      IF (is_mpi_root) PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2' 
    9595   CASE DEFAULT 
    96       PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), ' in dissip_gcm.f90/init_dissip' 
     96      IF (is_mpi_root) PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), ' in dissip_gcm.f90/init_dissip' 
    9797      STOP 
    9898   END SELECT 
    … …  
    103103      rayleigh_tau = rayleigh_tau / scale_factor 
    104104      IF(rayleigh_tau<=0) THEN 
    105          PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau 
     105         IF (is_mpi_root) PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau 
    106106         STOP 
    107107      END IF 
    … …  
    246246        u=du/dumax 
    247247      ENDDO 
    248       PRINT *,"gradiv : it :",it ,": dumax",dumax 
     248      IF (is_mpi_root) PRINT *,"gradiv : it :",it ,": dumax",dumax 
    249249 
    250250    ENDDO  
    251     PRINT *,"gradiv : dumax",dumax 
    252     PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., & 
    253          'effective T-cell half-edge size (km)', dumax**(-.5/nitergdiv)/1000 
    254     PRINT *, 'Max. time step assuming c=340 m/s and Courant number=2.8 :', & 
    255          2.8/340.*dumax**(-.5/nitergdiv) 
     251    IF (is_mpi_root) PRINT *,"gradiv : dumax",dumax 
     252    IF (is_mpi_root) PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., & 
     253                              'effective T-cell half-edge size (km)', dumax**(-.5/nitergdiv)/1000 
     254    IF (is_mpi_root)  PRINT *, 'Max. time step assuming c=340 m/s and Courant number=2.8 :', & 
     255                               2.8/340.*dumax**(-.5/nitergdiv) 
    256256 
    257257    cgraddiv=dumax**(-1./nitergdiv) 
    258     PRINT *,"cgraddiv : ",cgraddiv 
     258    IF (is_mpi_root) PRINT *,"cgraddiv : ",cgraddiv 
    259259 
    260260    DO ind=1,ndomain 
    … …  
    324324      ENDDO 
    325325       
    326       PRINT *,"gradrot : it :",it ,": dumax",dumax 
     326      IF (is_mpi_root) PRINT *,"gradrot : it :",it ,": dumax",dumax 
    327327 
    328328    ENDDO  
    329     PRINT *,"gradrot : dumax",dumax 
     329    IF (is_mpi_root) PRINT *,"gradrot : dumax",dumax 
    330330   
    331331    cgradrot=dumax**(-1./nitergrot)  
    332     PRINT *,"cgradrot : ",cgradrot 
     332    IF (is_mpi_root) PRINT *,"cgradrot : ",cgradrot 
    333333    
    334334 
    … …  
    384384        dthetamax=dthetamax1 
    385385      ENDIF 
    386       PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax 
     386      IF (is_mpi_root) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax 
    387387 
    388388      DO ind=1,ndomain 
    … …  
    396396 
    397397!    CALL writefield("divgrad",f_dtheta) 
    398     PRINT *,"divgrad : divgrad",dthetamax 
     398    IF (is_mpi_root) PRINT *,"divgrad : divgrad",dthetamax 
    399399   
    400400    cdivgrad=dthetamax**(-1./niterdivgrad)  
    401     PRINT *,"cdivgrad : ",cdivgrad 
     401    IF (is_mpi_root) PRINT *,"cdivgrad : ",cdivgrad 
    402402     
    403403 

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

    r116 r131  
    1414  USE disvert_dcmip200_mod, ONLY: ap_dcmip200=>ap, bp_dcmip200=>bp, presnivs_dcmip200=>presnivs, init_disvert_dcmip200=>init_disvert 
    1515  USE icosa 
     16  USE mpipara 
    1617  IMPLICIT NONE 
    1718    CHARACTER(LEN=255) :: disvert_type = 'std' 
    … …  
    5657         
    5758      CASE default 
    58         PRINT*,'Bad selector for variable disvert : <', TRIM(disvert_type),"> options are <std>, <ncar>, <ncarl30>"  
     59        IF (is_mpi_root) PRINT*,'Bad selector for variable disvert : <', TRIM(disvert_type),"> options are <std>, <ncar>, <ncarl30>"  
    5960        STOP 
    6061         
    … …  
    107108    status = NF90_ENDDEF(ncid)    
    108109     
    109     PRINT*,ap 
    110     PRINT*,bp 
    111110    status=NF90_PUT_VAR(ncid,ilevid, ap(:)+bp(:)*Preff) 
    112111     

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

    r116 r131  
    1111  SUBROUTINE init_disvert 
    1212  USE icosa 
     13  USE mpipara 
    1314  IMPLICIT NONE 
    1415   
    … …  
    2324  SUBROUTINE disvert(ap,bp,presnivs) 
    2425  USE icosa 
     26  USE mpipara 
    2527  IMPLICIT NONE 
    2628  REAL(rstd),INTENT(OUT) :: ap(:) 
    … …  
    5658  ENDDO 
    5759 
    58   PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
    59   PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
    60   PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
     60  IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
     61  IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
     62  IF (is_mpi_root) PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
    6163 
    6264END SUBROUTINE disvert 

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

    r115 r131  
    2323  SUBROUTINE disvert(ap,bp,presnivs) 
    2424  USE icosa 
     25  USE mpipara 
    2526  IMPLICIT NONE 
    2627  REAL(rstd),INTENT(OUT) :: ap(:) 
    … …  
    4041   
    4142  eta_top = (GG/Teq*exp(-N**2*llm*ncar_dz/g)+1-GG/Teq)**(1./kappa) 
    42   PRINT *,'eta_top ->', eta_top 
     43  IF (is_mpi_root) PRINT *,'eta_top ->', eta_top 
    4344  do l = 1,llm+1 
    4445     eta = (GG/Teq*exp(-N**2*(l-1)*ncar_dz/g)+1-GG/Teq)**(1./kappa) 
    45      PRINT *,'eta ->', eta 
     46     IF (is_mpi_root) PRINT *,'eta ->', eta 
    4647     bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx 
    4748     ap(l) = preff * ( eta - bp(l) ) 
    4849  ENDDO 
    49   PRINT *,'eta ->', eta 
     50  IF (is_mpi_root) PRINT *,'eta ->', eta 
    5051  bp(1)=1. 
    5152  ap(1)=0. 
    … …  
    5657  ENDDO 
    5758 
    58   PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
    59   PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
    60   PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
     59  IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
     60  IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
     61  IF (is_mpi_root) PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
    6162 
    6263END SUBROUTINE disvert 

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

    r25 r131  
    2323  SUBROUTINE disvert(ap,bp,presnivs) 
    2424  USE icosa 
     25  USE mpipara 
    2526  IMPLICIT NONE 
    2627  REAL(rstd),INTENT(OUT) :: ap(:) 
    … …  
    5758  ENDDO 
    5859 
    59   PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
    60   PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
     60  IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
     61  IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
    6162  PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
    6263 

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

    r66 r131  
    99  SUBROUTINE init_disvert 
    1010  USE icosa 
     11  USE mpipara 
    1112  IMPLICIT NONE 
    1213   
    … …  
    2324  SUBROUTINE disvert(ap,bp,presnivs) 
    2425  USE icosa 
     26  USE mpipara 
    2527  IMPLICIT NONE 
    2628  REAL(rstd),INTENT(OUT) :: ap(:) 
    … …  
    9799      presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff ) 
    98100   
    99       PRINT*, 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*8.,       & 
    100               ' DZ ~ ',8.*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
     101     IF (is_mpi_root) PRINT*, 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*8.,       & 
     102                               ' DZ ~ ',8.*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
    101103    ENDDO 
    102104   

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

    r19 r131  
    2222  SUBROUTINE disvert(ap,bp,presnivs) 
    2323  USE icosa 
     24  USE mpipara 
    2425  IMPLICIT NONE 
    2526  REAL(rstd),INTENT(OUT) :: ap(:) 
    … …  
    5657    ap(llm+1) = pa * ( sig(llm+1) - bp(llm+1) ) 
    5758     
    58     PRINT*,'ap',ap 
    59     PRINT*,'bp',bp 
     59    IF (is_mpi_root) PRINT*,'ap',ap 
     60    IF (is_mpi_root) PRINT*,'bp',bp 
    6061     
    61     PRINT*, 'Niveaux de pressions approximatifs aux centres des' 
    62     PRINT*, 'couches calcules pour une pression de surface =', preff 
    63     PRINT*, 'et altitudes equivalentes pour une hauteur d echelle de' 
    64     PRINT*, '8km' 
     62    IF (is_mpi_root) PRINT*, 'Niveaux de pressions approximatifs aux centres des' 
     63    IF (is_mpi_root) PRINT*, 'couches calcules pour une pression de surface =', preff 
     64    IF (is_mpi_root) PRINT*, 'et altitudes equivalentes pour une hauteur d echelle de' 
     65    IF (is_mpi_root) PRINT*, '8km' 
    6566     
    6667    DO l = 1, llm 
    6768      presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff ) 
    6869   
    69       PRINT*, 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*8.,       & 
    70               ' DZ ~ ',8.*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
     70      IF (is_mpi_root) PRINT*, 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*8.,       & 
     71                               ' DZ ~ ',8.*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10)) 
    7172    ENDDO 
    7273   

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

    r58 r131  
    3030    radius=radius/scale_factor 
    3131    omega=omega*scale_factor 
    32     PRINT *,"radius = ",radius 
    3332     
    3433  END SUBROUTINE init_earth_const 

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

    r97 r131  
    7575 
    7676   
    77   PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius) 
     77  IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius) 
    7878 
    7979   
    8080  CALL WriteField("Ai",geom%Ai) 
    8181!  CALL WriteField("sum_ne",sum_ne) 
    82   CALL write_apbp 
     82  IF (is_mpi_root) CALL write_apbp 
    8383  CALL init_time 
    8484  CALL timeloop 

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

    r21 r131  
    124124  CALL dist_cart(vertex_glo(3,1,1)%xyz,vertex_glo(4,1,1)%xyz,d3)  
    125125  CALL div_arc(vertex_glo(1,1,1)%xyz,vertex_glo(3,1,1)%xyz,0.5,p1) 
    126 !  CALL div_arc(vertex_glo(2,1,1)%xyz,vertex_glo(1,3,1)%xyz,1./3,p1) 
    127 !  CALL div_arc(vertex_glo(1,2,1)%xyz,vertex_glo(3,1,1)%xyz,1./3,p2) 
    128 !  CALL div_arc(vertex_glo(2,2,1)%xyz,vertex_glo(1,1,1)%xyz,1./3,p3) 
    129 !  PRINT *, "dist",d1 
    130 !  PRINT *, "dist",d2 
    131 !  PRINT *, "dist",d3 
    132 !  PRINT *,"dist",vertex_glo(2,1,1)%xyz 
    133 !  PRINT *,"dist",p1/sqrt(sum(p1**2)) 
     126 
    134127  CALL circumcenter(vertex_glo(1,1,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,2,1)%xyz,p1) 
    135128!  CALL Centroide(vertex_glo(1,2,1)%xyz,vertex_glo(2,1,1)%xyz,vertex_glo(1,1,1)%xyz,p1) 
    … …  
    138131  CALL dist_cart(vertex_glo(2,1,1)%xyz,p1,d2)  
    139132  CALL dist_cart(vertex_glo(1,2,1)%xyz,p1,d3)  
    140 !  PRINT *, "dist",d1 
    141 !  PRINT *, "dist",d2 
    142 !  PRINT *, "dist",d3 
    143133 
    144134  END SUBROUTINE compute_face 
    … …  
    337327          
    338328        ind=vertex_glo(i,j,nf)%ind 
    339         IF (ind==0) THEN 
    340           PRINT *,"ind=0",i,j,nf 
    341         ENDIF 
    342329        delta=MOD(vertex_glo(i,j,nf)%delta+neighbour+6,6) 
    343330        ind2=cell_glo(ind)%neighbour(delta) 
    … …  
    758745    cell_glo(ind)%neighbour(3)=cell_glo(ind)%neighbour(2) 
    759746       
    760  
    761     ind=vertex_glo(1,jjm_glo,1)%ind 
    762     DO i=0,5 
    763       ind2=cell_glo(ind)%neighbour(i) 
    764       IF (ind2>0) PRINT *,"neighbour",i,cell_glo(ind2)%assign_face,cell_glo(ind2)%assign_i,cell_glo(ind2)%assign_j 
    765     ENDDO 
    766      
    767747     
    768748 !! assignation des delta  

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

    r98 r131  
    2222  USE earth_const 
    2323  USE ioipsl 
     24  USE mpipara 
    2425  IMPLICIT NONE 
    2526  REAL(rstd) :: run_length 
    … …  
    3435    CALL getin('run_length',run_length) 
    3536    itaumax=run_length/dt 
    36     PRINT *,'itaumax=',itaumax 
     37    IF (is_mpi_root)  PRINT *,'itaumax=',itaumax 
    3738    dt=dt/scale_factor 
    3839 
    … …  
    4142    write_period=write_period/scale_factor 
    4243    itau_out=FLOOR(.5+write_period/dt) 
    43     PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out 
     44    IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out 
    4445     
    4546    CALL create_time_counter_header 
    … …  
    5152  USE prec 
    5253  USE ioipsl 
     54  USE mpipara 
    5355  IMPLICIT NONE 
    5456  INTEGER :: status 
    … …  
    5759  CHARACTER(LEN=255) :: time_frequency 
    5860   
    59     status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid) 
    60     status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid) 
    61     status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id) 
    62     status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time") 
    63     status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00") 
    64     status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap") 
    65     status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid) 
     61    IF (is_mpi_root) THEN  
     62      status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid) 
     63      status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid) 
     64      status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id) 
     65      status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time") 
     66      status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00") 
     67      status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap") 
     68      status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid) 
    6669 
    67     WRITE(time_frequency,*) write_period 
    68     PRINT*,TRIM(time_frequency) 
    69     status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s") 
     70      WRITE(time_frequency,*) write_period 
     71      PRINT*,TRIM(time_frequency) 
     72      status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s") 
    7073 
    71     status = NF90_ENDDEF(ncid)  
     74      status = NF90_ENDDEF(ncid)  
    7275 
    73     CALL getin("dt",dt) 
    74     status=NF90_PUT_VAR(ncid,dtid, dt) 
     76      CALL getin("dt",dt) 
     77      status=NF90_PUT_VAR(ncid,dtid, dt) 
     78    ENDIF 
    7579    it=0 
    7680 
    … …  
    7983  SUBROUTINE update_time_counter(time) 
    8084  USE netcdf_mod 
     85  USE mpipara 
    8186  USE prec 
    8287  IMPLICIT NONE 
    … …  
    8792   
    8893    it=it+1 
    89     status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /)) 
    90     status=NF90_SYNC(ncid) 
     94    IF (is_mpi_root) THEN  
     95      status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /)) 
     96      status=NF90_SYNC(ncid) 
     97    ENDIF 
     98 
    9199  END SUBROUTINE update_time_counter     
    92100   
    93101  SUBROUTINE close_time_counter 
    94102  USE netcdf_mod 
     103  USE mpipara 
    95104  IMPLICIT NONE 
    96105    INTEGER :: status 
    97106     
    98     status=NF90_CLOSE(ncid) 
     107     IF (is_mpi_root) status=NF90_CLOSE(ncid) 
    99108     
    100109  END SUBROUTINE  close_time_counter  

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

    r130 r131  
    1111  USE advect_tracer_mod 
    1212  USE physics_mod 
     13  USE mpipara 
    1314   
    1415  IMPLICIT NONE 
    … …  
    120121  DO it=0,itaumax 
    121122 
    122     PRINT *,"It No :",It,"   t :",dt*It 
     123    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It 
    123124    IF (mod(it,itau_out)==0 ) THEN 
    124125      CALL writefield("q",f_q) 
    … …  
    157158    END DO 
    158159 
    159 !    CALL dissip(f_u,f_du,f_ps,f_phis, f_theta_rhodz,f_dtheta_rhodz) 
    160 !    CALL euler_scheme(.FALSE.) 
     160    CALL dissip(f_u,f_du,f_ps,f_phis, f_theta_rhodz,f_dtheta_rhodz) 
     161    CALL euler_scheme(.FALSE.) 
    161162 
    162163!    CALL advect_tracer(f_ps,f_u,f_q) 
    … …  
    187188      IMPLICIT NONE 
    188189      INTEGER :: ind, stage 
    189 !      REAL(rstd), DIMENSION(4), PARAMETER :: coef = (/ 1., 4./3., 2., 4. /) 
    190190      REAL(rstd), DIMENSION(4), PARAMETER :: coef = (/ .25, 1./3., .5, 1. /) 
    191191      REAL(rstd) :: tau 
Note: See TracChangeset for help on using the changeset viewer.