- Timestamp:
- 2009-11-23T11:52:11+01:00 (14 years ago)
- Location:
- trunk/NEMO/OFF_SRC
- Files:
-
- 1 added
- 7 edited
-
DOM/domngb.F90 (added)
-
IOM/in_out_manager.F90 (modified) (3 diffs)
-
IOM/iom.F90 (modified) (14 diffs)
-
IOM/iom_ioipsl.F90 (modified) (4 diffs)
-
IOM/iom_nf90.F90 (modified) (2 diffs)
-
IOM/iom_rstdimg.F90 (modified) (7 diffs)
-
opa.F90 (modified) (1 diff)
-
step.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/IOM/in_out_manager.F90
r1642 r1749 77 77 INTEGER :: nn_jctls = 0 !: Start j indice for the SUM control 78 78 INTEGER :: nn_jctle = 0 !: End j indice for the SUM control 79 INTEGER :: nn_isplt = 1!: number of processors following i80 INTEGER :: nn_jsplt = 1!: number of processors following j79 INTEGER :: nn_isplt = 1 !: number of processors following i 80 INTEGER :: nn_jsplt = 1 !: number of processors following j 81 81 INTEGER :: nn_bench = 0 !: benchmark parameter (0/1) 82 82 INTEGER :: nn_bit_cmp = 0 !: bit reproducibility (0/1) … … 90 90 !! logical units 91 91 !!---------------------------------------------------------------------- 92 INTEGER :: numstp 92 INTEGER :: numstp = -1 !: logical unit for time step 93 93 INTEGER :: numout = 6 !: logical unit for output print 94 INTEGER :: numnam !: logical unit for namelist 95 INTEGER :: numnam_ice !: logical unit for ice namelist 96 INTEGER :: numevo_ice !: logical unit for ice variables (temp. evolution) 97 INTEGER :: numsol !: logical unit for solver statistics 98 INTEGER :: numwri !: logical unit for output write 99 INTEGER :: numgap !: logical unit for differences diagnostic 100 INTEGER :: numbol !: logical unit for "bol" diagnostics 101 INTEGER :: numptr !: logical unit for Poleward TRansports 102 INTEGER :: numflo !: logical unit for drifting floats 94 INTEGER :: numnam = -1 !: logical unit for namelist 95 INTEGER :: numnam_ice = -1 !: logical unit for ice namelist 96 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 97 INTEGER :: numsol = -1 !: logical unit for solver statistics 103 98 104 99 !!---------------------------------------------------------------------- … … 149 144 IF( PRESENT(cd10) ) WRITE(numout,*) cd10 150 145 ENDIF 151 CALL FLUSH(numout) 146 CALL FLUSH(numout ) 147 IF( numstp /= -1 ) CALL FLUSH(numstp ) 148 IF( numsol /= -1 ) CALL FLUSH(numsol ) 149 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice) 152 150 ! 153 151 END SUBROUTINE ctl_stop -
trunk/NEMO/OFF_SRC/IOM/iom.F90
r1697 r1749 27 27 28 28 #if defined key_iomput 29 USE domngb ! ocean space and time domain 30 USE phycst ! physical constants 31 USE dianam ! build name of file 29 32 USE mod_event_client 33 USE mod_attribut 30 34 # endif 31 35 … … 34 38 35 39 #if defined key_iomput 36 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag40 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag 37 41 #else 38 42 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 39 43 #endif 40 41 44 PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 42 45 … … 55 58 END INTERFACE 56 59 INTERFACE iom_put 57 MODULE PROCEDURE iom_p 2d, iom_p3d60 MODULE PROCEDURE iom_p0d, iom_p2d, iom_p3d 58 61 END INTERFACE 59 62 #if defined key_iomput … … 71 74 CONTAINS 72 75 73 SUBROUTINE iom_init ( pjulian )76 SUBROUTINE iom_init 74 77 !!---------------------------------------------------------------------- 75 78 !! *** ROUTINE *** … … 78 81 !! 79 82 !!---------------------------------------------------------------------- 80 REAL(wp), INTENT(in) :: pjulian !: julian day at nit000 = 081 83 #if defined key_iomput 84 REAL(wp) :: ztmp 82 85 !!---------------------------------------------------------------------- 83 86 ! read the xml file … … 85 88 86 89 ! calendar parameters 87 CALL event__set_time_parameters( nit000 - 1, pjulian, rdt ) 90 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 91 CASE ( 1) ; CALL event__set_calendar('gregorian') 92 CASE ( 0) ; CALL event__set_calendar('noleap' ) 93 CASE (30) ; CALL event__set_calendar('360d' ) 94 END SELECT 95 ztmp = fjulday - adatrj 96 IF( ABS(ztmp - REAL(NINT(ztmp),wp)) < 0.1 / rday ) ztmp = REAL(NINT(ztmp),wp) ! avoid truncation error 97 CALL event__set_time_parameters( nit000 - 1, ztmp, rdt ) 88 98 89 99 ! horizontal grid definition 100 CALL set_scalar 90 101 CALL set_grid( "grid_T", glamt, gphit ) 91 102 CALL set_grid( "grid_U", glamu, gphiu ) … … 98 109 CALL event__set_vert_axis( "depthv", gdept_0 ) 99 110 CALL event__set_vert_axis( "depthw", gdepw_0 ) 111 112 ! automatic definitions of some of the xml attributs 113 CALL set_xmlatt 100 114 101 115 ! end file definition … … 180 194 ! do we read the overlap 181 195 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 182 llnoov = (jpni * jpnj ) == jpnij 196 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 183 197 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 184 198 ! ============= … … 525 539 ! do we read the overlap 526 540 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 527 llnoov = (jpni * jpnj ) == jpnij 541 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 528 542 ! check kcount and kstart optionals parameters... 529 543 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') … … 894 908 895 909 !!---------------------------------------------------------------------- 896 !! INTERFACE iom_ rstput910 !! INTERFACE iom_put 897 911 !!---------------------------------------------------------------------- 912 SUBROUTINE iom_p0d( cdname, pfield0d ) 913 CHARACTER(LEN=*), INTENT(in) :: cdname 914 REAL(wp) , INTENT(in) :: pfield0d 915 #if defined key_iomput 916 CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 917 #else 918 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 919 #endif 920 END SUBROUTINE iom_p0d 921 898 922 SUBROUTINE iom_p2d( cdname, pfield2d ) 899 923 CHARACTER(LEN=*) , INTENT(in) :: cdname … … 901 925 #if defined key_iomput 902 926 CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 927 #else 928 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 903 929 #endif 904 930 END SUBROUTINE iom_p2d … … 909 935 #if defined key_iomput 910 936 CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 937 #else 938 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 911 939 #endif 912 940 END SUBROUTINE iom_p3d … … 920 948 !! *** ROUTINE *** 921 949 !! 922 !! ** Purpose : 950 !! ** Purpose : define horizontal grids 923 951 !! 924 952 !!---------------------------------------------------------------------- … … 934 962 END SUBROUTINE set_grid 935 963 964 965 SUBROUTINE set_scalar 966 !!---------------------------------------------------------------------- 967 !! *** ROUTINE *** 968 !! 969 !! ** Purpose : define fake grids for scalar point 970 !! 971 !!---------------------------------------------------------------------- 972 REAL(wp), DIMENSION(1,1) :: zz = 1. 973 !!---------------------------------------------------------------------- 974 CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1) 975 CALL event__set_grid_domain ( 'scalarpoint', 1, 1, narea, 1, zz, zz ) 976 CALL event__set_grid_type_nemo( 'scalarpoint' ) 977 978 END SUBROUTINE set_scalar 979 980 981 SUBROUTINE set_xmlatt 982 !!---------------------------------------------------------------------- 983 !! *** ROUTINE *** 984 !! 985 !! ** Purpose : automatic definitions of some of the xml attributs... 986 !! 987 !!---------------------------------------------------------------------- 988 CHARACTER(len=6),DIMENSION( 8) :: clsuff ! suffix name 989 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 990 CHARACTER(len=50) :: clname ! file name 991 CHARACTER(len=1) :: cl1 ! 1 character 992 CHARACTER(len=2) :: cl2 ! 1 character 993 INTEGER :: idt ! time-step in seconds 994 INTEGER :: iddss, ihhss ! number of seconds in 1 day, 1 hour and 1 year 995 INTEGER :: iyymo ! number of months in 1 year 996 INTEGER :: jg, jh, jd, jm, jy ! loop counters 997 INTEGER :: ix, iy ! i-,j- index 998 REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings 999 REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings 1000 REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings 1001 REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings 1002 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1003 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1004 !!---------------------------------------------------------------------- 1005 ! 1006 idt = NINT( rdttra(1) ) 1007 iddss = NINT( rday ) ! number of seconds in 1 day 1008 ihhss = NINT( rmmss * rhhmm ) ! number of seconds in 1 hour 1009 iyymo = NINT( raamo ) ! number of months in 1 year 1010 1011 ! frequency of the call of iom_put (attribut: freq_op) 1012 CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt ) ) ! model time-step 1013 1014 ! output file names (attribut: name) 1015 clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /) 1016 DO jg = 1, SIZE(clsuff) ! grid type 1017 DO jh = 1, 12 ! 1, 2, 3, 4, 6, 12 hours 1018 IF( MOD(12,jh) == 0 ) THEN 1019 WRITE(cl2,'(i2)') jh 1020 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1021 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1022 ENDIF 1023 END DO 1024 DO jd = 1, 5, 2 ! 1, 3, 5 days 1025 WRITE(cl1,'(i1)') jd 1026 CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 1027 CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1028 END DO 1029 DO jm = 1, 6 ! 1, 2, 3, 4, 6 months 1030 IF( MOD(6,jm) == 0 ) THEN 1031 WRITE(cl1,'(i1)') jm 1032 CALL dia_nam( clname, -jm, clsuff(jg) ) 1033 CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1034 ENDIF 1035 END DO 1036 DO jy = 1, 10 ! 1, 2, 5, 10 years 1037 IF( MOD(10,jy) == 0 ) THEN 1038 WRITE(cl2,'(i2)') jy 1039 CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 1040 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1041 ENDIF 1042 END DO 1043 END DO 1044 1045 ! Zooms... 1046 clgrd = (/ 'T', 'U', 'W' /) 1047 DO jg = 1, SIZE(clgrd) ! grid type 1048 cl1 = clgrd(jg) 1049 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1050 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1051 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin , iy ) ) 1052 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni , jpiglo ) ) 1053 CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq' ) ) 1054 END DO 1055 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 1056 zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /) 1057 zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /) 1058 CALL set_mooring( zlontao, zlattao ) 1059 ! RAMA moorings (attributs: ibegin, jbegin, name_suffix) 1060 zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /) 1061 zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /) 1062 CALL set_mooring( zlonrama, zlatrama ) 1063 ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix) 1064 zlonpira = (/ -38.0, -23.0, -10.0 /) 1065 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1066 CALL set_mooring( zlonpira, zlatpira ) 1067 1068 END SUBROUTINE set_xmlatt 1069 1070 1071 SUBROUTINE set_mooring( plon, plat) 1072 !!---------------------------------------------------------------------- 1073 !! *** ROUTINE *** 1074 !! 1075 !! ** Purpose : automatic definitions of moorings xml attributs... 1076 !! 1077 !!---------------------------------------------------------------------- 1078 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 1079 ! 1080 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name 1081 CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name 1082 CHARACTER(len=50) :: clname ! file name 1083 CHARACTER(len=1) :: cl1 ! 1 character 1084 CHARACTER(len=6) :: clon,clat ! name of longitude, latitude 1085 INTEGER :: ji, jj, jg ! loop counters 1086 INTEGER :: ix, iy ! i-,j- index 1087 REAL(wp) :: zlon, zlat 1088 !!---------------------------------------------------------------------- 1089 DO jg = 1, SIZE(clgrd) 1090 cl1 = clgrd(jg) 1091 DO ji = 1, SIZE(plon) 1092 DO jj = 1, SIZE(plat) 1093 zlon = plon(ji) 1094 zlat = plat(jj) 1095 ! modifications for RAMA moorings 1096 IF( zlon == 67. .AND. zlat == 15. ) zlon = 65. 1097 IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95. 1098 IF( zlon == 95. .AND. zlat == -4. ) zlat = -5. 1099 ! modifications for PIRATA moorings 1100 IF( zlon == -38. .AND. zlat == -19. ) zlon = -34. 1101 IF( zlon == -38. .AND. zlat == -14. ) zlon = -32. 1102 IF( zlon == -38. .AND. zlat == -8. ) zlon = -30. 1103 IF( zlon == -38. .AND. zlat == 0. ) zlon = -35. 1104 IF( zlon == -23. .AND. zlat == 20. ) zlat = 21. 1105 IF( zlon == -10. .AND. zlat == -14. ) zlat = -10. 1106 IF( zlon == -10. .AND. zlat == -8. ) zlat = -6. 1107 IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF 1108 CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 1109 IF( zlon >= 0. ) THEN 1110 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e' 1111 ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e' 1112 ENDIF 1113 ELSE 1114 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w' 1115 ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w' 1116 ENDIF 1117 ENDIF 1118 IF( zlat >= 0. ) THEN 1119 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n' 1120 ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n' 1121 ENDIF 1122 ELSE 1123 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's' 1124 ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's' 1125 ENDIF 1126 ENDIF 1127 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1128 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin , ix ) ) 1129 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin , iy ) ) 1130 CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) ) 1131 END DO 1132 END DO 1133 END DO 1134 1135 END SUBROUTINE set_mooring 1136 936 1137 #else 937 1138 938 1139 SUBROUTINE iom_setkt( kt ) 939 1140 INTEGER, INTENT(in ):: kt 1141 IF( .FALSE. ) WRITE(numout,*) kt ! useless test to avoid compilation warnings 940 1142 END SUBROUTINE iom_setkt 941 1143 -
trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90
r1324 r1749 48 48 !! ** Purpose : open an input file with IOIPSL (only fliocom module) 49 49 !!--------------------------------------------------------------------- 50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 51 INTEGER , INTENT( out) :: kiomid ! ioipsl identifier of the opened file 52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 53 LOGICAL , INTENT(in ) :: ldok ! check the existence 54 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 55 56 CHARACTER(LEN=100) :: clinfo ! info character 57 INTEGER :: iln ! lengths of character 58 INTEGER :: istop ! temporary storage of nstop 59 INTEGER :: ifliodom ! model domain identifier (see flio_dom_set) 60 INTEGER :: ioipslid ! ioipsl identifier of the opened file 61 INTEGER :: jl ! loop variable 50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 51 INTEGER , INTENT( out) :: kiomid ! ioipsl identifier of the opened file 52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 53 LOGICAL , INTENT(in ) :: ldok ! check the existence 54 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 55 56 CHARACTER(LEN=100) :: clinfo ! info character 57 CHARACTER(LEN=10 ) :: clstatus ! status of opened file (REPLACE or NEW) 58 INTEGER :: iln ! lengths of character 59 INTEGER :: istop ! temporary storage of nstop 60 INTEGER :: ifliodom ! model domain identifier (see flio_dom_set) 61 INTEGER :: ioipslid ! ioipsl identifier of the opened file 62 INTEGER :: jl ! loop variable 63 LOGICAL :: llclobber ! local definition of ln_clobber 62 64 !--------------------------------------------------------------------- 63 65 … … 65 67 istop = nstop 66 68 ! 67 IF( ldok ) THEN ! Open existing file... 69 llclobber = ldwrt .AND. ln_clobber 70 IF( ldok .AND. .NOT. llclobber ) THEN ! Open existing file... 68 71 ! ! ============= 69 72 IF( ldwrt ) THEN ! ... in write mode … … 78 81 iln = INDEX( cdname, '.nc' ) 79 82 IF( ldwrt ) THEN ! the file should be open in write mode so we create it... 83 IF( llclobber ) THEN ; clstatus = 'REPLACE' 84 ELSE ; clstatus = 'NEW' 85 ENDIF 80 86 IF( jpnij > 1 ) THEN 81 87 ! define the domain position regarding to the global domain (mainly useful in mpp) … … 86 92 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode' 87 93 CALL fliocrfd( cdname, (/'x' , 'y' , 'z', 't'/) & 88 & , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom )94 & , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom, mode = clstatus ) 89 95 ELSE ! the file should be open for read mode so it must exist... 90 96 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode' 91 97 CALL fliocrfd( cdname, (/'x' , 'y' , 'z', 't'/) & 92 & , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid )98 & , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, mode = clstatus ) 93 99 ENDIF 94 100 ELSE ! the file should be open for read mode so it must exist... -
trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90
r1324 r1749 49 49 !! ** Purpose : open an input file with NF90 50 50 !!--------------------------------------------------------------------- 51 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 52 INTEGER , INTENT( out) :: kiomid ! nf90 identifier of the opened file 53 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 54 LOGICAL , INTENT(in ) :: ldok ! check the existence 55 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 56 57 CHARACTER(LEN=100) :: clinfo ! info character 58 CHARACTER(LEN=100) :: cltmp ! temporary character 59 INTEGER :: iln ! lengths of character 60 INTEGER :: istop ! temporary storage of nstop 61 INTEGER :: if90id ! nf90 identifier of the opened file 62 INTEGER :: idmy ! dummy variable 63 INTEGER :: jl ! loop variable 51 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 52 INTEGER , INTENT( out) :: kiomid ! nf90 identifier of the opened file 53 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 54 LOGICAL , INTENT(in ) :: ldok ! check the existence 55 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 56 57 CHARACTER(LEN=100) :: clinfo ! info character 58 CHARACTER(LEN=100) :: cltmp ! temporary character 59 INTEGER :: iln ! lengths of character 60 INTEGER :: istop ! temporary storage of nstop 61 INTEGER :: if90id ! nf90 identifier of the opened file 62 INTEGER :: idmy ! dummy variable 63 INTEGER :: jl ! loop variable 64 INTEGER :: ichunk ! temporary storage of nn_chunksz 65 INTEGER :: imode ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER 66 LOGICAL :: llclobber ! local definition of ln_clobber 64 67 !--------------------------------------------------------------------- 65 68 66 69 clinfo = ' iom_nf90_open ~~~ ' 67 70 istop = nstop ! store the actual value of nstop 68 ! 69 IF( ldok ) THEN ! Open existing file... 71 IF( nn_chunksz > 0 ) THEN ; ichunk = nn_chunksz 72 ELSE ; ichunk = NF90_SIZEHINT_DEFAULT 73 ENDIF 74 ! 75 llclobber = ldwrt .AND. ln_clobber 76 IF( ldok .AND. .NOT. llclobber ) THEN ! Open existing file... 70 77 ! ! ============= 71 78 IF( ldwrt ) THEN ! ... in write mode 72 79 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode' 73 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE , if90id), clinfo)74 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo)80 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE , if90id, chunksize = ichunk ), clinfo) 81 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 75 82 ELSE ! ... in read mode 76 83 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode' 77 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id), clinfo)78 ENDIF 79 ELSE ! the file does not exist84 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 85 ENDIF 86 ELSE ! the file does not exist (or we overwrite it) 80 87 ! ! ============= 81 88 iln = INDEX( cdname, '.nc' ) … … 86 93 ENDIF 87 94 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode' 88 CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), NF90_NOCLOBBER, if90id ), clinfo) 89 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 95 96 IF( llclobber ) THEN ; imode = NF90_CLOBBER 97 ELSE ; imode = NF90_NOCLOBBER 98 ENDIF 99 CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo) 100 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 90 101 ! define dimensions 91 102 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) -
trunk/NEMO/OFF_SRC/IOM/iom_rstdimg.F90
r1152 r1749 48 48 !! ** Purpose : open an input file read only (return 0 if not found) 49 49 !!--------------------------------------------------------------------- 50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name51 INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file?53 LOGICAL , INTENT(in ) :: ldok ! check the existence54 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters:50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 51 INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file 52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 53 LOGICAL , INTENT(in ) :: ldok ! check the existence 54 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 55 55 56 56 CHARACTER(LEN=100) :: clinfo ! info character 57 57 CHARACTER(LEN=100) :: cltmp ! temporary character 58 CHARACTER(LEN=10 ) :: clstatus ! status of opened file (REPLACE or NEW) 58 59 INTEGER :: jv ! loop counter 59 60 INTEGER :: istop ! temporary storage of nstop … … 70 71 INTEGER :: iiglo, ijglo ! domain global size 71 72 INTEGER :: jl ! loop variable 73 LOGICAL :: llclobber ! local definition of ln_clobber 72 74 CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) :: clna0d, clna1d, clna2d, clna3d ! name of 0/1/2/3D variables 73 REAL(wp), DIMENSION(jpmax_vars) :: zval0d, zval1d, zval2d, zval3d ! value of 0d variables or record74 ! ! position for 1/2/3D variables75 REAL(wp), DIMENSION(jpmax_vars) :: zval0d, zval1d, zval2d, zval3d ! value of 0d variables or record 76 ! ! position for 1/2/3D variables 75 77 !--------------------------------------------------------------------- 76 78 clinfo = ' iom_rstdimg_open ~~~ ' … … 78 80 ios = 0 ! default definition 79 81 kiomid = 0 ! default definition 82 llclobber = ldwrt .AND. ln_clobber 80 83 ! get a free unit 81 84 idrst = getunit() ! get a free logical unit for the restart file … … 85 88 ! Open the file... 86 89 ! ============= 87 IF( ldok ) THEN ! Open existing file...90 IF( ldok .AND. .NOT. llclobber ) THEN ! Open existing file... 88 91 ! find the record length 89 92 OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct' & … … 101 104 & , RECL = irecl8, STATUS = 'old', ACTION = 'read' , IOSTAT = ios, ERR = 987 ) 102 105 ENDIF 103 ELSE ! the file does not exist106 ELSE ! the file does not exist (or we overwrite it) 104 107 iln = INDEX( cdname, '.dimg' ) 105 108 IF( ldwrt ) THEN ! the file should be open in readwrite mode so we create it... … … 110 113 ENDIF 111 114 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in READWRITE mode' 115 116 IF( llclobber ) THEN ; clstatus = 'REPLACE' 117 ELSE ; clstatus = 'NEW' 118 ENDIF 112 119 OPEN( idrst, FILE = TRIM(cdname), FORM = 'UNFORMATTED', ACCESS = 'DIRECT' & 113 & , RECL = irecl8, STATUS = 'new', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )120 & , RECL = irecl8, STATUS = TRIM(clstatus), ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 114 121 ELSE ! the file should be open for read mode so it must exist... 115 122 CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) … … 118 125 ! Performs checks on the file 119 126 ! ============= 120 IF( ldok ) THEN ! old file127 IF( ldok .AND. .NOT. llclobber ) THEN ! old file 121 128 READ( idrst, REC = 1 , IOSTAT = ios, ERR = 987 ) & 122 129 & irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd, & -
trunk/NEMO/OFF_SRC/opa.F90
r1715 r1749 216 216 217 217 CALL phy_cst ! Physical constants 218 219 218 CALL eos_init ! Equation of state 220 221 219 CALL dom_cfg ! Domain configuration 222 223 220 CALL dom_init ! Domain 224 225 221 CALL istate_init ! ocean initial state (Dynamics and tracers) 226 222 CALL trc_ini ! Passive tracers 227 223 CALL dta_dyn( nit000 ) ! Initialization for the dynamics 228 229 CALL trc_ini ! Passive tracers230 ! ! Ocean physics231 224 CALL tra_qsr_init ! Solar radiation penetration 232 233 225 #if ! defined key_off_degrad 234 226 CALL ldf_tra_init ! Lateral ocean tracer physics 235 227 #endif 236 CALL iom_init( fjulday - adatrj ) ! iom_put initialization 237 ! ! =============== ! 238 ! ! time stepping ! 239 ! ! =============== ! 228 CALL iom_init ! iom_put initialization 240 229 241 230 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA -
trunk/NEMO/OFF_SRC/step.F90
r1457 r1749 73 73 !! --------------------------------------------------------------------- 74 74 75 CALL day( kstp ) ! Calendar75 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 76 76 77 77 IF( lk_iomput ) CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp
Note: See TracChangeset
for help on using the changeset viewer.
