source: codes/icosagcm/trunk/src/disvert.f90 @ 131

Last change on this file since 131 was 131, checked in by ymipsl, 11 years ago

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

YM
File size: 4.5 KB
RevLine 
[12]1MODULE disvert_mod
[19]2  USE icosa
[17]3  REAL(rstd), SAVE, POINTER :: ap(:)
4  REAL(rstd), SAVE, POINTER :: bp(:)
5  REAL(rstd), SAVE, POINTER :: presnivs(:)
[12]6
7CONTAINS
8
9  SUBROUTINE init_disvert
[17]10  USE disvert_std_mod, ONLY: ap_std=>ap, bp_std=>bp, presnivs_std=>presnivs, init_disvert_std=>init_disvert
11  USE disvert_ncar_mod, ONLY: ap_ncar=>ap, bp_ncar=>bp, presnivs_ncar=>presnivs, init_disvert_ncar=>init_disvert
[33]12  USE disvert_ncarl30_mod, ONLY: ap_ncarl30=>ap, bp_ncarl30=>bp, presnivs_ncarl30=>presnivs, init_disvert_ncarl30=>init_disvert
[115]13  USE disvert_dcmip31_mod, ONLY: ap_dcmip31=>ap, bp_dcmip31=>bp, presnivs_dcmip31=>presnivs, init_disvert_dcmip31=>init_disvert
[116]14  USE disvert_dcmip200_mod, ONLY: ap_dcmip200=>ap, bp_dcmip200=>bp, presnivs_dcmip200=>presnivs, init_disvert_dcmip200=>init_disvert
[19]15  USE icosa
[131]16  USE mpipara
[12]17  IMPLICIT NONE
[17]18    CHARACTER(LEN=255) :: disvert_type = 'std'
19   
20    CALL getin("disvert",disvert_type)
21   
22    SELECT CASE (TRIM(disvert_type))
23      CASE('std')
24   
25        CALL init_disvert_std
26        ap=>ap_std
27        bp=>bp_std
28        presnivs=>presnivs_std
29     
30      CASE ('ncar')
[12]31
[17]32        CALL init_disvert_ncar
33        ap=>ap_ncar
34        bp=>bp_ncar
35        presnivs=>presnivs_ncar
[33]36
[115]37      CASE ('dcmip31')
38
39        CALL init_disvert_dcmip31
40        ap=>ap_dcmip31
41        bp=>bp_dcmip31
42        presnivs=>presnivs_dcmip31
43
[116]44      CASE ('dcmip200')
45
46        CALL init_disvert_dcmip200
47        ap=>ap_dcmip200
48        bp=>bp_dcmip200
49        presnivs=>presnivs_dcmip200
50
[33]51      CASE ('ncarl30')
52
[64]53        CALL init_disvert_ncarl30
[33]54        ap=>ap_ncarl30
55        bp=>bp_ncarl30
56        presnivs=>presnivs_ncarl30
[17]57       
58      CASE default
[131]59        IF (is_mpi_root) PRINT*,'Bad selector for variable disvert : <', TRIM(disvert_type),"> options are <std>, <ncar>, <ncarl30>" 
[17]60        STOP
61       
62    END SELECT
[12]63
64  END SUBROUTINE init_disvert 
65 
[75]66  SUBROUTINE write_apbp
67  USE icosa
68  USE netcdf_mod
69  IMPLICIT NONE
70    REAL(rstd) :: val(llm)
71    INTEGER :: status
72    INTEGER :: lev,ilev
73    INTEGER :: ncid,levid,ilevid,hyaiid,hybiid,hyamid,hybmid,P0id
74    INTEGER :: l
75   
76    status = NF90_CREATE('apbp.nc', NF90_CLOBBER, ncid)
77    status = NF90_DEF_DIM(ncid,'lev',llm,lev)
78    status = NF90_DEF_DIM(ncid,'ilev',llm+1,ilev)
79   
80    status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ lev /),levid)
81    status = NF90_PUT_ATT(ncid,levid,"long_name","hybrid level at midpoints (1000*(A+B))")
82    status = NF90_PUT_ATT(ncid,levid,"units","Pa")
83    status = NF90_PUT_ATT(ncid,levid,"positive","up")
84    status = NF90_PUT_ATT(ncid,levid,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate")
85    status = NF90_PUT_ATT(ncid,levid,"formula_terms","a: hyam b: hybm p0: P0 ps: PS")
86
87    status = NF90_DEF_VAR(ncid,'ilev',NF90_DOUBLE,(/ ilev /),ilevid)
88    status = NF90_PUT_ATT(ncid,ilevid,"long_name","hybrid level at interfaces (1000*(A+B))")
89    status = NF90_PUT_ATT(ncid,ilevid,"units","Pa")
90    status = NF90_PUT_ATT(ncid,ilevid,"positive","up")
91    status = NF90_PUT_ATT(ncid,ilevid,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate")
92    status = NF90_PUT_ATT(ncid,ilevid,"formula_terms","a: hyai b: hybi p0: P0 ps: PS")
93   
94    status = NF90_DEF_VAR(ncid,'hyai',NF90_DOUBLE,(/ ilev /),hyaiid)
95    status = NF90_PUT_ATT(ncid,hyaiid,"long_name","hybrid A coefficient at layer interfaces")
96
97    status = NF90_DEF_VAR(ncid,'hybi',NF90_DOUBLE,(/ ilev /),hybiid)
98    status = NF90_PUT_ATT(ncid,hybiid,"long_name","hybrid B coefficient at layer interfaces")
99
100    status = NF90_DEF_VAR(ncid,'hyam',NF90_DOUBLE,(/ lev /),hyamid)
101    status = NF90_PUT_ATT(ncid,hyamid,"long_name","hybrid A coefficient at midpoint interfaces")
102
103    status = NF90_DEF_VAR(ncid,'hybm',NF90_DOUBLE,(/ lev /),hybmid)
104    status = NF90_PUT_ATT(ncid,hybmid,"long_name","hybrid B coefficient at midpoint interfaces")
105   
106    status = NF90_DEF_VAR(ncid,'P0',NF90_DOUBLE,varid=P0id)
107
108    status = NF90_ENDDEF(ncid)   
109   
110    status=NF90_PUT_VAR(ncid,ilevid, ap(:)+bp(:)*Preff)
111   
112    DO l=1,llm
113      val(l)= 0.5*(ap(l+1)+ap(l)+Preff*(bp(l)+bp(l+1)))
114    ENDDO
115   
116    status=NF90_PUT_VAR(ncid,levid, val)
117
118    status=NF90_PUT_VAR(ncid,hyaiid, ap(:)/Preff)
[112]119    status=NF90_PUT_VAR(ncid,hybiid, bp(:))
[75]120   
121    DO l=1,llm
122      val(l)= 0.5*(ap(l+1)+ap(l))
123    ENDDO
124    status=NF90_PUT_VAR(ncid,hyamid, val(:)/Preff)
125   
126     DO l=1,llm
127      val(l)= 0.5*(bp(l+1)+bp(l))
128    ENDDO
129    status=NF90_PUT_VAR(ncid,hybmid, val(:))
130 
131    status=NF90_PUT_VAR(ncid,P0id, Preff)
132   
133   status=NF90_CLOSE(ncid)
134  END SUBROUTINE write_apbp
135
[12]136END MODULE disvert_mod
Note: See TracBrowser for help on using the repository browser.